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SUMMARY 
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This  report  describes  a  suite  of  programs  to  be  used  for 
management  of  a  Signal  Measurement  Data  Base  (SMDB) .  The  pro¬ 
grams  permit  a  user  to  write  on  disk,  from  tape,  files  of  seis¬ 
mic  signal  measurements  which  have  been  used,  for  example,  in 
VELA- sponsored  identification  experiments.  The  program  suite 
consists  of  software  to  establish  the  SMDB  and  to  enable  user 
interface  with  the  data  base.  Moreover,  the  structure  of  the 
SMDB  is  also  presented  here  to  illustrate  its  expandable  and 

maintainable  format. 
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Neither  the  Advanced  Research  Projects  Agency  nor  the 
Air  Force  Technical  Applications  Center  will  be  responsible 
for  information  contained  herein  which  has  been  supplied  by 
other  organizations  or  contractors,  and  this  document  is 
subject  to  later  revision  as  may  be  necessary.  The  views 
and  conclusions  presented  are  those  of  the  authors  and  should 
not  be  interpreted  as  necessarily  representing  the  official 
policies,  either  expressed  or  implied,  of  the  Advanced  Re¬ 
search  Projects  Agency,  the  Air  Force  Technical  Applications 
Center,  or  the  US  Government. 
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SECTION  I 
INTRODUCTION 
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*> 
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The  purpose  of  the  Data  Base  Transfer  (Task  4.3.1  under 
Contract  Number  FO  8606  -  79 -C-00  14)  is  to  transfer  the  Event 
Discriminant  Data  Base  from  the  PDP-15/50  to  the  PDP-11/70, 
and  to  do  so  under  the  following  constraints: 

•  Preserve  the  signal  measurements  for  all  event- 
stations  processed  under  Contract  Number  F08606- 
79  - C- 00 14  . 

•  Establish  an  expandable  and  maintainable  Signal 
Measurement  Data  Base  (SMDB)  on  the  PDP- 11/70  that: 

satisfies  the  first  constraint  above 
may  be  updated  with  additional  signal  measure¬ 
ments  for  event-station  data  processed  by  other 
contractors . 

•  Provide  FORTRAN-compatible  software  utilities  to: 

initialize  the  SMDB  Directory  and  Free-Block 
File 

update  the  SMDB  by  event,  station,  measurement, 
or  contractor 

access  the  SMDB  for  information  by  event,  sta¬ 
tion,  measurement,  or  contractor. 

•  Write  selected  driving  programs  to  demonstrate  an: 

SMDB  update  with  signal  measurements  discussed 
in  the  first  criterion 

SMDB  access  to  list  Directory  information  and 
signal  measurements 
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SMDB  access  to  compute  unbiased  network  averages 
of  signal  measurements  for  a  specified  event. 


•  Demonstrate  this  software  contingent  on  the  avail¬ 
ability  of  UNIX  operating  system  utilities  provided 
by  the  Government. 

Section  II  of  the  report  describes  the  detailed  structure 
of  the  SMDB.  Section  III  discusses  the  establishment  of  the 
SMDB,  utilizing  signal  measurements  for  all  event -station  data 
processed  under  Contract  Number  FO 860 6- 79 -C- 00 14 .  Section  IV 
presents  conclusions  and  recommendations  for  future  work. 
Finally,  documentation  of  the  software  utilities  developed 
during  the  task  is  provided  in  Appendix  A  of  this  report, 
while  listings  of  the  software  may  be  found  in  Appendix  B. 
Appendix  C  contains  a  description  of  ENSCO’s  raw  signal  mea¬ 
surement  tape  format. 
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SECTION  II 

STRUCTURE  OF  THE  SIGNAL  MEASUREMENT  DATA  BASE  ( SMDB ) 


The  Signal  Measurement  Data  Base  (SMDB)  uses  a  multi¬ 
file  structure  which  is  designed  and  implemented  in  FORTRAN 
IV  for  the  PDP-11/70.  The  principal  items  comprising  the 
SMDB  are  vectors  of  signal  measurements  obtained  by  preproces¬ 
sing  waveform  data  from  various  recording  stations.  The  de¬ 
sign  of  the  data  base  wras  predicated  on  the  following  criteria 

•  Expandability  with  respect  to  events,  stations, 
and  measurements. 

•  Allocations  for  data  from  up  to  four  contractors. 

To  this  end,  a  linklist  structure  was  employed  in  organizing 
the  data. 

The  SMDB  consists  of  four  types  of  files: 

•  A  Directory  File  (SIGMS.DIR). 

(  A  Directory  Freeblock  File  (SIGMSDIR.FRE) . 

•  Signal  Measurement  Data  Files  (one  file  for  each 
event) . 

•  Freeblock  File  for  Data  Files  (one  file  for  each 
event ) . 

The  general  organization  of  the  SMDB  is  shown  in  Figure  II- 1. 

The  directory  file,  SIGMS.DIR,  consists  of  a  header 
record  followed  by  Event  Base  Vectors  and  Station  Entry  Vec¬ 
tors.  These  vectors  are  for  sorting  and  retrieving  event/ 
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FIGURE  1 1 -  1 

ORGANIZATION  OF  THE  SIGNAL  MEASUREMENT  DATA  BASE  (SMDB) 


signal  information.  The  header  record  contains  the  following 
info rmation: 

•  The  current  number  of  events  in  the  system. 

•  The  record  number  of  the  first  event  entry. 

•  The  current  number  of  directory  records  that  are 
in  use. 

•  The  maximum  number  of  directory  records  allowed. 

All  entries  are  allocated  four  bytes  of  storage. 

The  structure  of  the  Event  Base  Vector  and  Station  Entry 
Vector  are  shown  in  Figure  1 1 -  2 .  Each  entry  record  is  128 
bytes  long  and  consists  of  thirty-two  four-byte  words.  The 
attributes  of  the  Event  Base  Vector  are  defined  as  follows: 

•  Event  Sequence  Number  -  A  virtual  integer  J,  where 
1<J<#  of  events,  which  indicates  the  order  an  event 
appears  in  the  directory.  For  example,  the  fifth 
event  listed  in  the  directory  has  an  event  sequence 
number  of  5.  The  sequence  number  for  an  event 
changes  when  the  SMDB  is  updated  with  new  events. 

•  Event  Designation  Number  -  A  unique  four-digit 
number  appearing  as  the  last  four  characters  of  the 
ENSCO-alphanumeric  event  designation. 

•  Event  Origin  Time  -  Source  time  in  YY  DDD  HH  MM  SS 
(5  word  integer  format). 

•  Event  Latitude  -  Source  latitude  in  degrees,  N(+), 

S(-). 

•  Event  Longitude  -  Source  longitude  in  degrees , 

EO),  W(-). 

•  Event  -  Event  bodywave  magnitude. 
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•  Event  Depth  -  Source  depth  in  km. 

•  Backward  Pointer  to  Last  Event  -  The  record  number 
corresponding  to  the  previous  event  base  vector 

( zero  if  first  event). 

•  Forward  Pointer  to  Next  Event  -  The  record  number 
corresponding  to  the  next  event  base  vector  (zero 
if  last  event) . 

•  Total  Number  of  Stations  -  The  total  number  of  sta¬ 
tion  entry  vectors  for  the  event.  This  corresponds 
to  the  total  number  of  unique  stations  for  which 
measurements  are  available  for  a  given  event. 

•  Point  to  First  Station  -  The  record  number  corres¬ 
ponding  to  the  first  station  entry  vector  for  the 
event . 

The  attributes  of  the  Station  Entry  Vector  are  defined  as 
follows : 

•  Station  Name  -  The  four-character  ENSCO- alphanumeric 
station  designation. 

•  Station  Number  -  The  integer  number  K,  1<Ks50 ,  as¬ 
signed  to  a  given  station. 

•  Backward  Pointer  to  Last  Station  -  The  record  number 
corresponding  to  the  last  station  entry  vector 
(zero  if  first  station). 

•  Forward  Pointer  to  Next  Station  -  The  record  number 
corresponding  to  the  next  station  entry  vector 
(zero  if  last  station). 

•  Total  Number  of  Contractors  -  The  total  number  of 
contractors  contributing  signal  measurements  for  an 
event-station  (maximum  of  four). 
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•  Contractor  Name  -  The  four-character  alphanumeric 
designation  for  a  contributor  to  the  data  base. 

•  First  Measurement  Record  -  The  record  number  in  the 
signal  measurement  data  file  corresponding  to  the 
first  record  of  signal  measurements. 

•  Number  of  Measurements  -  The  total  number  of  mea¬ 
surement  values  contributed  by  the  associated  con¬ 
tractor. 

Both  the  event  base  vectors  and  the  station  entry  vectors 
have  unused  locations  where,  if  desired,  additional  informa¬ 
tion  can  be  stored. 

The  directory  freeblock  file,  SIGMSDIR. FRE ,  consists  of 
a  header  record  containing  the  current  number  of  non- sequent ial 
free  records  in  the  directory  file.  This  header  record  is 
followed  by  records  consisting  of  256  four-byte  words.  These 
records  each  contain  up  to  256  record  numbers.  The  function 
of  this  freeblock  is  to  allow  the  reuse  of  records  freed  by 
the  deletion  of  entries  in  the  directory  file.  This  practice 
minimizes  the  size  of  the  directory  file. 

Each  event  has  one  signal  measurement  file  with  a  name 
of  the  form  SIGMXXXX.DAT,  where  XXXX  is  the  event  designa¬ 
tion  number.  The  records  in  these  files  consist  of  64  four- 
byte  words.  Two  types  of  records  make  up  the  data  file:  a 
header  record  and  data  records  (multiple).  The  header  record 
contains  the  current  number  of  data  records  in  use  and  the 
maximum  number  of  data  records  allowed  in  the  first  two  posi¬ 
tions.  The  structure  of  the  data  records  is  shown  in  Figure 
1 1  -  5 .  The  major  attributes  are  defined  as  follows: 
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•  Measurement  Value  -  A  signal  parameter  obtained  by 
preprocessing  waveform  data  from  various  recording 
stations.  In  the  present  case,  the  measurements 
are  ordered  into  four  categories  depending  on  the 
type  of  data  from  which  the  discriminants  are  de¬ 
rived  (namely,  long-period  signals/noise,  short- 
period  regional  signals/noise,  short-period  tele- 
seismic  signals/noise,  and  short-period  signals/ 
noise) . 

•  Measurement  Labels  -  A  four- character  alphanumeric 
designation  associated  with  each  measurement  value. 
This  label  is  used  as  a  keyword  in  locating  a  given 
signal  parameter. 

•  Last  Measurement  Record  -  The  record  number  corres¬ 
ponding  to  the  last  data  record  associated  with  a 
given  contractor  (zero  if  first  record). 

•  Next  Measurement  Record  -  The  record  number  corres¬ 
ponding  to  the  next  data  record  associated  with  a 
given  contractor  (zero  if  last  record) . 

Each  event  also  has  a  freeblock  file  associated  with  its 
signal  measuremen1-  file.  The  files  are  named  analogously  to 
the  data  file.  The  file  name  is  of  the  form  SIGMXXXX. FRE , 

I  where  XXXX  is  the  event  designation  number.  The  structure 

and  function  of  this  file  are  the  same  as  those  of  the 
directory  freeblock  file. 


I 


> 
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SECTION  III 

ESTABLISHMENT  OF  THE  SMDB 


The  SMDB  is  established  by  executing  DDBASE.  This 
routine  takes  a  labeled  1600  bpi  9-track  signal  measurement 
tape  as  input.  The  data  headers  for  each  event-station  file 
should  follow  the  description  in  Table  III-l*.  Before  DDBASE 
is  initially  run,  the  program  INITIAL  must  be  executed.  This 
program  initializes  the  directory  files  of  the  data  base  and 
deletes  any  data  files  that  may  be  present.  In  general,  the 
UNIX  command  SMT  must  also  be  performed  with  the  appropriate 
options  before  any  execution  of  DDBASE.  These  routines  along 
with  other  support  routines  and  subroutines  are  documented 
in  Appendix  A.  The  source  file  names  and  the  names  of  the 
associated  source  files  and  libraries  (if  any)  are  also  pro¬ 
vided.  The  algorithms  can  be  executed  by  following  the  stand¬ 
ard  UNIX  FORTRAN  guidelines.  Appendix  B  contains  compiled 
listings  of  the  data  base  management  and  demonstration  pro¬ 
grams  . 


The  conversion  of  the  data  header  from  the  standard  ENSCO 
format  (see  Appendix  C)  is  performed  by  the  IBM  360/44  pro¬ 
gram  COPY99. 
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TABLE  1 1 1  - 1 


SIGNAL  MEASUREMENT  DATA  HEADER 
(PAGE  1  OF  3) 


Pos it  ion 

Data 

Type 

Description 

1 

I 

Seismogram  number  (not  used). 

2 

I 

Number  of  components  (always  equal  to  one). 

3 

I 

Edit  length  (always  equal  to  100) . 

4 

F 

Sample  rate  (not  used) . 

5 

F 

Edit  start  time:  hours  . 

6 

F 

Edit  start  time:  minutes  >  (not  used). 

7 

F 

Edit  start  time:  seconds  ' 

8-9 

A 

1 TIHEADER' . 

10-12 

A 

Event  designation  (word  12  is  the  event 
designation  number). 

13-14 

A 

Data  type  ( ' DISCR' ) . 

15 

A 

Data  orientation  code  ('RAN'). 

16-47 

A 

Site  status  table  (not  used) . 

48 

A 

'  bbYY'  \ 

49 

A 

'bDDD'  1 

50 

A 

'bbHH'  >  event  origin  time. 

51 

A 

' bbMM'  1 

52 

A 

' bbSS'  J 

53 

A 

Confidence  of  source  time  (PDE  code)  (not 
used) . 

54-55 

A 

Event  latitude  (+90°N)  (represents  F8. 5) . 

56-57 

A 

Event  longitude  (+180°E)  (represents  F8. 3) . 

58 

A 

Event  depth  (represent  integer). 

59 

A 

Event  (represents  F4.2). 
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SIGNAL  MEASUREMENT  DATA  HEADER 
(PAGE  2  OF  3) 


Pos it  ion 


Data 

Type 


Description 


63-64 


68-69 


96-97 


99-157 


159-160 

161-162 


Event  Mg  (represents  F4.2). 

Event  m^  (represents  F4.2). 

ENSCO  estimated  Mg  (represents  F4.2). 
Information  source  (e.g.,  'NEIL'). 

Event  -  station  tectonic  class  code. 

Not  used. 

Site  number  (represents  integer) . 

Signal  measurement  fields  for  specific 
phase  (represents  F8. 3)  (meaningless  in 
context  of  signal  measurement  tape). 

Signal  measurement  fields  for  specific 
phase  (represents  F8. 3)  (meaningless  in 
context  of  signal  measurement  tape). 

Array  name  ( ' SROb ' ) . 

Not  used. 

Array  name. 

Site  latitude  (+90°N)  (represents  F8.3). 

Site  longitude  (+180°E)  (represents  F8. 3) . 

P-wave  arrival  seconds  into  edit  (represents 
integer) . 

S-wave  arrival  seconds  into  edit  (represents 
integer) . 

LQ-wave  arrival  seconds  into  edit  (repre¬ 
sents  integer) . 

LR-wave  arrival  seconds  into  edit  (repre¬ 
sents  integer) . 
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SIGNAL  MEASUREMENT  DATA  HEADER 
(PAGE  3  OF  3) 


Position 


168-169 


171-172 


173-322 

323-324 


573-574 


Data 

Type 


Description 


Estimated  LR  length  (seconds)  (represents 
integer) . 

Station  azimuth  (degrees)  (great  circle 
beam  direction)  (represents  F8.3). 

Station  elevation  (meters)  (great  circle 
beam  direction)  (represents  integer). 

Source-to-stat ion  epicentral  distance 
great  circle  distance  (degrees)  (represents 
F8.3). 

Not  used. 

Signal  measurement  fields  for  specific 
phases  (represents  F8. 3)  (meaningless  in 
context  of  signal  measurement  tape). 

Signal  measurement  fields  for  specific 
phases  (represents  F8. 3)  (meaningless  in 
contest  of  signal  measurement  tape). 

Not  used. 
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SECTION  IV 

CONCLUSIONS  AND  RECOMMENDATIONS 


An  expandable  and  maintainable  Signal  Measurement  Data 
Base  (SMDB)  program  suite  has  been  designed  and  compiled  on 
the  PDP-11/70  under  the  UNIX  operating  system.  Tapes  (from 
the  SDAC)  which  were  used  in  the  VELA- sponsored  identifica¬ 
tion  experiment,  and  which  were  used  in  the  development  and 
test  of  the  SMDB  program  suite,  are: 

1.  L22882  (IBM  360/44) 

2.  LI 30 33  (DEC  PDP-15/S0). 

These  tapes  can  be  used  in  future  efforts  to  refine  the  SMDB 
program  suite. 

It  should  be  noted  that  several  problems  were  encounter¬ 
ed  with  the  UNIX  FORTRAN  compilers  during  attempts  to  imple¬ 
ment  the  SMDB  routines.  Specifically,  the  routines  were 
initially  coded  in  a  modified  version  of  DEC  RT-1'1  FORTRAN  IV 
(Rottman,  1975).  (The  UNIX  command  to  request  this  compiler 
is  FORTRAN.)  Difficulties  encountered  with  this  compiler  in¬ 
cluded  problems  which  are  apparently  related  to  array  size 
and  to  the  argument  lists.  That  is,  a  routine  could  be  made 
to  generate  routine  errors,  or  not  to  do  so,  by  increasing 
or  decreasing  the  size  of  its  arrays,  respectively.  Associ¬ 
ated  error  messages,  in  general,  indicated  a  bus  error  or  a 
segmentation  violation.  Regardless,  a  solution  to  this  prob¬ 
lem  was  not  readily  apparent.  Further,  the  number  of 
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arguments  in  a  subroutine  argument  list  appeared  to  be 
limited  to  eight.  Any  additional  arguments  were  not  passed. 
It  was  possible  to  circumvent  this  problem  by  passing  argu¬ 
ments  in  a  named  common  block. 

Toward  the  end  of  this  task,  a  new  FORTRAN  compiler  was 
provided  (Anon.,  1978).  This  compiler  is  based  on  American 
National  Standard  (ANS j  FORTRAN  77.  (The  UNIX  command  to 
request  this  compiler  is  F77.)  An  investigation  was  made 
into  the  feasibility  of  converting  the  SMDB  routines  to  the 
FORTRAN  77  standard.  Necessary  changes  would  include  sub¬ 
stitution  of  the  ENCODE/DECODE  statements  with  equivalent 
statements,  modification  of  the  file  I/O,  modification  of 
character  variables,  and  modification  of  the  code  to  allow 
for  irregularities  in  the  new  compiler.  ENCODE/DECODE  state 
ments  can  be  replaced  with  'reads'  and  'writes'  to  internal 
files.  This  replacement  is  not  possible  on  a  one_-to-one 
basis,  and  some  additional  program  structuring  will  be 
necessary  to  provide  for  parallel  operations.  The  file  I/O 
initiated  using  the  routines  SETFIL  and  DFILE  does  not  ap¬ 
pear  to  be  equivalent  to  using  SETFIL  and  DEFINE  FILE  in  the 
original  compiler.  In  particular,  it  seems  that  the  file  to 
be  accessed  must  already  exist  in  order  to  be  accessed  (i.e. 
the  system  does  not  create  a  new  file).  This  was  not  the 
case  with  the  compiler  called  using  FORTRAN.  Another  dif¬ 
ference  in  file  I/O  requirements  was  that  the  last  record 
written  in  a  file  could  not  be  read  subsequent  to  the  write 
to  the  file.  This  difficulty  may  indicate  that  it  is  neces¬ 
sary  to  close  and  open  the  file  between  write  and  read  op¬ 
erations.  An  example  of  one  irregularity  encountered  during 
the  investigation  of  the  F77  compiler  is  the  failure  to 
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compile  a  logical  expression  with  a  unary  minus  (e.g.,  if 
(IFLG.EQ.-l)  go  to  100).  The  same  logical  expression  with¬ 
out  the  minus  sign,  however,  does  compile. 

The  results  of  the  investigation  made  indicate  that  the 
F77  compiler  is  sufficiently  different  from  the  FORTRAN 
compiler  as  to  require  a  significant  effort  to  convert  the 
SMDB  from  the  FORTRAN  to  the  F77  compiler.  It  will  first  be 
necessary  to  establish  the  operating  characteristics  of  the 
new  compiler  (i.e.,  the  logic  sequences  necessary  to  accom¬ 
plish  a  given  operation).  After  the  methods  for  performing 
the  desired  operations  have  been  established  (usually  done 
by  the  trial - and-error  method),  the  SMDB  routines  can  be 
restructured  (i.e.,  converted). 

At  this  time,  a  competent  FORTRAN  language  compiler  is 
not  available  on  the  SDAC  PDP- 11/70.  Note,  however,  that 
the  use  of  the  FORTRAN  language  is  not  recommended  by  the 
designers  of  the  UNIX  operating  system  for  major  applications 
using  UNIX. 

As  a  final  comment,  several  additional  routines  could 
be  added  to  make  the  SMDB  more  versatile.  These  include  a 
function  to  delete  event  and/or  station  entries  and  a  func¬ 
tion  to  modify  individual  measurements  resident  in  the  data 
base.  The  design  of  the  SMDB  included  consideration  of  these 
avenues  for  development.  Several  of  the  routines  documented 
in  Appendix  A  could  be  used  to  implement  these  options. 
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APPENDIX  A 

DOCUMENTATION  OF  SIGNAL  MEASUREMENT  DATA  BASE  (SMDB)  ROUTINES 


This  appendix  contains  descriptions  of  the  main  routines 
and  associated  subroutines  used  to  manage  and  demonstrate  the 
SMDB.  These  descriptions  include  definitions  of  arguments, 
commons,  and  data  types.  Comments  on  the  use  of  the  routines 
are  also  provided.  Applicable  source  files  resident  on  the 
PDP-11/70  system  are  listed. 

These  routines  can  be  incorporated  into  additional 
algorithms  to  manipulate  the  SMDB.  Several  examples  of  this 
type  of  application  are  generation  of  files  of  unbiased  net¬ 
work  magnitude  measurements,  computation  of  discriminants, 
and  classification  of  events. 
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Subrout ine : 

ACCESS 

Arguments : 

(NDSG ,  STAT,  CONTR,  MS  LAB ,  NRET,  RMEAS ,  RLAB,  IEVR) . 

NDSG  -  integer  *  4 

STAT  -  real  *  4 

CONTR  -  real  *  4 

MS LAB  -  real  *  4 

NRET  -  .integer  *  4 

RMEAS  -  real  *  4  array  of  lengthy  NRET 
RLAB  -  real  *  4  array  of  length  >_NRET 
IEVR  -  integer  *  4 


Commons : 

COMMON/FLAGS/ IFLGMS,  IFLGEV 
IFLGMS  -  integer  *  2 
IFLGEN  -  integer  *  2 

COMMON/ ASVAR/NXREC1 ,  NXREC2 ,  NXREC3 ,  NXREC4 
Description : 

ACCESS  accesses  the  signal  measurement  data  base  and  re¬ 
turns  the  measurements . 

NDSG  is  an  event  designation  number. 

STAT  is  a  four- character  station  name  (if  it  is  ****,  the 
given  measurement  is  returned  for  all  stations  re¬ 
porting  the  event) . 

CONTR  is  a  four-character  contractor  name. 

MSLAB  is  a  four- charact er  measurement  label. 

NRET  is  the  number  of  measurements  returned. 

RMEAS  contains  the  measurements  to  be  returned. 
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RLAB  contains  the  measurement  labels  when  IFLGMS-0. 

IEVR  is  the  event  record  number  in  the  directory  file 
SIGMS .DIR. 

0,  returns  all  measurements  for  the  given 
station  (in  RMEAS)  with  the  associated 
labels  (in  RLAB)  —  WARNING:  it  should 
be  noted  that  there  is  no  guarantee  that 
all  of  the  measurements  will  be  in  order 
(or  exist)  across  stations. 

1,  return  only  indicated  measurement  for  the 
given  station. 

0,  search  for  event 
1,  use  event  record  number  in  IEVR. 

NXREC1,  NXREC2,  NXREC3,  NXREC4  are  the  associated  vari¬ 
ables  for  the  maximum  of  four  data  base  files  open 
at  one  time. 

Restrictions : 

1)  The  event  data  file  is  opened  on  logical  unit  num¬ 
ber  2  . 

2)  It  is  assumed  that  the  directory  file  SIGMS. DIR  is 
already  open  on  logical  unit  number  1. 

Source  File: 

access . for 

Associated  Source  File:  -  - 

search .for 


IFLGMS 


IFLGEV 


■  i 
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Subroutine : 


CHKFRE 
Arguments : 

(LUNIT,  IFLAG,  NFB,  IFREC) . 

LUNIT  -  integer  *  2 
IFLAG  -  integer  *  2 
NFB  -  integer  *  4 
IFREC  -  integer  *  4 

Commons : 

COMMON/ ASVAR/NXREC1 ,  NXREC2  ,  NXREC3,  NXREC4 
all  variables  integer  *  2 

Description: 

CHKFRE  checks  the  indicated  freeblock  file  and  either  re¬ 
turns  a  free  record  number  of  extends  the  freeblock  file.  The 
file  is  modified  accordingly  and  the  total  number  of  freeblocks 
before  the  call  is  returned. 

LUNIT  is  the  logical  unit  number  associated  with  the 

freeblock  file  (in  practice  LUNIT=3  is  the  freeblock 
file  for  the  directory  and  LUNIT=4  is  the  freeblock 
file  for  the  event  data  file. 

.0,  returns  free  record  number  in  IFREC 
IFLAG  <1,  freeblock  extended  with  record  number  in 
'  IFREC. 

NFB  is  the  number  of  freeblocks  prior  to  a  call. 

IFREC  is  the  free  record  number. 

NXREC1,  NXREC2,  NXREC3,  NXREC4  are  the  associated  variables 
for  all  possible  open  data  base  files. 
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Rest  rict ions : 

1)  The  appropriate  freeblock  files  must  be  open  on 
logical  unit  LUNIT. 

Source  File: 

chkf re . for 


Q 
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Main  Routine: 


COPY99 
Input : 

Signal  measurement  tape  in  standard  ENSCO  format. 
Description: 

COPY99  is  an  IBM  360/44  program  used  to  convert  the  data 
headers  of  the  signal  measurement  tape  to  the  format  expected 
by  the  PDP- 11/70  program  DDBASE  and  output  the  results  to 
another  tape.  The  output  tape  is  input  to  the  signal  measure¬ 
ment  data  base  management  routines.  Prior  to  execution  of 
this  program,  the  character  string  'NSKIP'  should  be  changed 
to  the  number  of  data  files  to  skip  on  the  input  tape  before 
starting  the  conversion  and  copy.  The  input  tape  is  accessed 
on  unit  8  and  the  output  tape  is  accessed  on  unit  9. 
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Main  Routine: 


DDBASE 
Input  r 

9-track  signal  measurement  tape  with  appropriate  EBCDIC 
data  headers  on  logical  unit  0. 

Description: 

DDBASE  accesses  the  information  on  a  labeled  1600  bpi  9- 
track  signal  'measurement  tape  and  performs  the  necessary  con¬ 
versions  and  formating  before  providing  the  information  to 
sut routine  UPDATE.  This  routine  includes  a  look-up  table  for 
station  names  based  on  the  station  number,  a  look-up  table 
for  measurement  labels,  EBCDIC  to  ASCII  conversion,  and  IBM 
360/44  to  PDP-11/70  floating-point  conversion. 

Restrict  ions : 

1)  The  9-track  input  tape  must  have  the  correct  EBCDIC 
header . 

2)  All  information  for  an  event  on  a  tape  must  be  con¬ 
secutive  . 

3)  IJNIX  command  smt  must  be  performed  before  execution 
of  DDBASE  with  the  appropriate  options. 

4)  The  algorithm  currently  requires  the  tape  to  be 
mounted  on  unit  0  (allowable  units  are  0-7). 

Source  File: 

ddbase .  for 
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Associated  Source  Files: 


update . for 
search . for 
chkfre. for 

Program  Source  File: 
ddbasep. foT 

Associated  libraries  (in  addition  to  normal  FORTRAN  library) : 
/lib/f4u 
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Main  Routine: 


EVLIST 

Input :  (from  terminal) 

Logic  flag  (IFLG)  (requested  inputs  0  or  1)  range  of 
event  sequence  numbers  (virtual) . 

Description: 

EVLIST  displays  the  event - st at  ion  information  stored 
in  the  data  b'ase  in  the  form  requested  by  the  input  parameters. 

If  a  zero  input  for  the  logic  flag  the  event  information 
and  the  stations  reporting  are  displayed. 

If  a  one  is  input  the  individual  station  measurements 
for  contractor  ENSC  are  included. 

Source  File: 

evl ist . for 

Associated  Source  Files: 

search . for 
access . for 

Program  Source  File: 
evl istp. for 
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Main  Routine: 

INITIAL 

Des  cr ipt ion : 

INITIAL  initializes  the  signal  measurement  data  base. 
This  is  accomplished  by  deleting  all  existing  event  data 
files  (if  any)  and  by  initializing  the  header  records  of  the 
directory  file  (SIGMS.DIR)  and  its  freeblock  file  (SIGMSDIR. 
FRE)  . 

Program  Source  File: 


initial. for 
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Subrout  ine : 


MB  IAS 
Arguments : 

(RMX,  NSTA ,  NDISC,  DISCR) . 

RMX  -  real  *  4  of  length  > NSTA  *  NDISC. 

NSTA  -  scalar  (integer  *  2). 

NDISC  -  scalar  (integer  *  2). 

DISCR  -  real  *  4  array  of  length  >  NDISC. 

Des  cription : 

MBIAS  performs  Ringdal's  maximum  likelihood  estimation 
of  event  magnitude  (Ringdal,  1975)  using  signal  and  noise 
me  asurements . 

RMX  is  a  matrix  whose  elements  contain  signal  or  noise 

measurements,  or  a  flag  indicating  that  the  element 
is  to  be  ignored. 

{signal  measurement  +  1000 
noise  measurement  -  1000 
0  if  it  is  to  be  ignored. 

NSTA  is  the  number  of  stations. 

NDISC  is  the  number  of  measurements  per  station. 

DISCR  contains  the  unbiased  magnitude  estimates. 

Restrictions : 

1)  RMS  contains  the  measurements  for  station  1  followed 
by  the  measurements  for  station  2,  etc.  until  the 
measurements  for  station  NSTA  have  been  stored. 

2)  NSTA  must  be  <_50. 

Source  File: 

mb ias  cat .for 
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Main  Routine: 

NAVE  and  (NAVE 2) 

Input :  (from  terminal) 

Event  designation  number. 


Description: 


NAVE  and  NAVE2  are  drivers  to  demonstrate  the  subroutine 
MBIAS.  The  unbiased  network  averages  are  computed  for  several 
measurements  for  the  designated  event. 


Source  File: 

nave. for  and  naveZ.for 


Associated  Source  Files: 

mb ias  cat . for 
search . for 
acces  s . for 


Main  Routine: 


RETURN 

Input :  (from  terminal) 

Event  designation  number 
Station  name 
Measurement  label. 

Description: 

RETURN  i'S  a  debugging  routine  to  test  sub 
and  SEARCH.  Various  measurements  are  returned 
the  input  parameters  and  the  setting  of  flags 
the  program. 

Source  File: 

re  turn . for 

Associated  Source  Files: 

search . for 
access . for 

Program  Source  File: 
returnp . for 
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depending  on 
hardwired  into 


Subroutine : 


SEARCH 


Arguments : 


( I  FLAG,  KEY,  EVREC,  STREC,  ICON,  MSREC ,  MSIND,  ISRCH) 

IFLAG  -  integer  *  2 

KEY  -  four  word  real  *  4  array 

EVREC  -  integer  *  4 

STREC  -  integer  *  4 

ICON  -  .integer  *  4 

MSREC  -  integer  *  4 

MSIND  -  integer  *  2 

ISRCH  -  integer  *  2 


Commons : 

COMMON/ ASVAR/ NXREC2 ,  NXREC2 ,  NXREC3 ,  NXREC4 
all  variables  INTEGER  *  2. 


Description: 


SEARCH  searches  the  signal  measurement  data  base  for  a 
match  to  a  specific  keyword  and  returns  the  appropriate 
record  number  and  index  (if  applicable). 

0,  full  search  for  a  given  measurement  (needs  all 
keywords ) 

1,  search  for  event  designation  number 

2,  search  for  station  name  (needs  evrec) 

3,  search  for  contractor  name  (needs  strec) 

4,  search  for  measurement  (needs  icon)  (returns  record 
number  in  ' s igmxxxx . de t '  file  and  the  index  into 
the  record) . 
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KEY  is  the  four-word  array  containing  the  keywords 

KEY(l)  =  event  designation  number  (should  be  con¬ 
verted  to  floating  point  prior  to  call) 
KEY(2)  =  four- character  station  name 
KEY(3)  =  four- character  contractor  name 
KEY(4)  =  four- character  measurement  label. 

EVREC  is  the  event  record  number  in  the  directory  file, 
SIGMS .DIR. 

STREC  is  the  station  record  number  in  the  directory  file, 
SIGMS. DIR. 

ICON  is  'the  index  into  the  station  record  of  the  contrac¬ 
tor  block  -  possible  values  are  21,  24,  27,  and  30. 

MSREC  is  the  measurement  record  number  in  the  event  data 
file  SIGMXXX.DAT. 

MSIND  is  the  index  into  the  measurement  record  of  the 
measurement  value 

ISRCH  is  an  error  flag 

ISRCH  =  J®,  successful  search 

'1,  unsuccessful  search 

NXREC1 ,  NXREC2 ,  NXREC3 ,  NXREC4  are  the  associated 

variables  of  all  possible  open  data  base  files. 


Restrictions 


If  EVREC  or  STREC  are  equal  to  zero  when  IFLAG=2  or 
3,  respectively,  the  program  is  stopped.  This  also 
occurs  if  the  number  of  stations  or  measurements 
is  zero. 

The  content  of  KEY(l)  must  be  in  floating  point 
representation . 

The  directory  file  SIGMS. DIR  must  be  open  on  logical 
unit  number  1  and  the  event  data  file  must  be  open 
on  logical  unit  number  2. 
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Source  File: 


search . for 
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Subrout ine : 


it 

l 


♦ 


» 


UPDATE 

Arguments : 

(I ERR) 

IERR  -  integer  *  2 
Commons : 

COMMON/ ARG/ES INFO 

ESINFO  -  141-word  real  *  4  array 

common/ ASVAR/NXREC1,  NXREC2 ,  NXREC3,  NXREC4 

all  variables  integer  *  2 

Des  cr iption : 

UPDATE  establishes  the  signal  measurement  data  base 
given  the  pertinent  event- stat ion  information  and^flags  con¬ 
tained  in  array  ESINFO. 

IERR  is  an  error  flag. 

IERR 

ESINFO  is 
base 
ESINFO(l) 

ESINFO ( 2 ) 

ES  INFO  ( 3) 

ES INFO ( 4 ) 

ESINFO( 5) 

ES INFO (6) 

ESINFOC7) 

m  tms  data  base j  . 


_ j 0  ,  no  errors 

*•1,  error  in  establishing  data  base, 
the  information  packet  passed  to  this  data 
routine . 

=  event  designation  number  (integer  *  4). 

event  origin  time  (integer  *  4). 

atitude  (+90°N) (represented  as  FS. 5 


bbYY 

bDDD 

bbHH 

bbMM 

bbSS 

event 
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ESINF0(8)  =  event  longitude  (+180°E)  (represented  as 
F8.3  in  this  data  base). 

ESINF0(9)  =  event  magnitude  (m^)  (represented  as  F4.2 
in  this  data  base). 

ESINFO(IO)  =  depth  of  event  (integer  *  4). 

ESINFO(ll)  =  event  flag  IFLGEV  (integer  *4). 

ESINFO(12)  =  four- character  station  name. 

ESINFO(13)  =  station  number  (integer  *  4). 

ESINFO(14)  =  station  flag  IFLGST  (integer  *  4). 

ESINF0(15)  =  four-character  contractor  name. 

ES INFO(  1'6  + (K- 1)  *2)  =  four- character  measurement  label 
K=  1 , 62  . 

ESINFO ( 17+ (K- 1) *2)  =  associated  measurement  value  K=1.62. 
ESINFO(140)  =  event  record  number  in  the  directory  file 
SIGMS.DIR  (integer  *  4). 

ESINF0(141)  =  station  record  number  in  the  directory 
file  SIGMS.DIR  (integer  *  4). 

IFLGEV  (ESINFO(ll))  is  a  flag  that  controls  the  logic 
flow  of  this  routine  in  regard  to  events. 

{1,  search  for  event 
0 ,  add  new  event 

-1,  update  previous  event  (i.e.,  use  event 
record  number  supplied  in  ESINFO( 140) ) . 
IFLGST  (ESINFO(14))  is  a  flag  that  controls  the  logic 
flow  of  this  routine  in  regard  to  stations. 

(1 ,  search  for  station 
0 ,  add  new  station 

-1,  update  previous  station  (i.e.,  use  sta¬ 
tion  record  provided  in  ES INFO( 14 1) ) . 
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The  following  files  are  associated  with  the  indicated  logical 
units . 

SIGMS.DIR  (directory  file)  logical  unit  =  1. 

SIGMXXXX.DAT  (event  data  file,  where  XXXX  is  the  event 
designation  number)  logical  unit  =  2. 

SIGMSDIR.FRE  (directory  freeblock  file)  logical  unit  =  3. 

SIGMXXXX.FRE  (freeblock  file  for  event  data  file)  logical 
unit  =  4 . 

NXREC1,  NXREC2 ,  NXREC5,  NXREC4  are  the  associated 
variables  for  all  possible  open  files. 


Comments : 

1)  If  an  event  is  either  flagged  as  new  (i.e.,  not 
presently  in  the  data  base)  or  not  found  in  a 
search,  the  station  flag  is  set  to  zero  to  indicate 
that  the  stations  are  also  new. 

2)  For  the  most  efficient  execution  of  this,  routine , 
the  event - stat ion  information  for  a  given  event 
should  be  provided  consecutively  during  a  given  run. 

3)  Update  is  written  in  such  a  way  that  measurements 
associated  with  an  existing  label  can  be  replaced 
by  the  value  in  the  information  packet. 

4)  In  general,  the  data  base  structure  implemented  by 
this  routine  is  expandable  with  respect  to  events, 
stations,  and  measurements  (linklist  structure). 

Restrictions : 

1)  The  directory  file  must  be  open  on  logical  unit  1 
and  the  directory  freeblock  file  must  be  open  on 
logical  unit  3. 

2)  Logical  units  2  and  4  must  be  free. 
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3)  The  number  of  associated  measurement  labels  and 

values  must  be  <62.  If  the  number  is  less  than  62, 
the  last  measurement  value  must  be  followed  by  a 
word  containing  four  blank  characters. 

Source  File: 

update,  for 

Associated  Source  Files: 

search . for 
chkf re . for 
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APPENDIX  B 

LISTINGS  OF  SIGNAL  MEASUREMENT  DATA  BASE  (SMDB)  PROGRAMS 


This  appendix  contains  compiled  listings  of  various 
data  base  management  and  demonstration  programs.  They  are 
COPY99 ,  INITIAL,  DDBASE ,  EVLIST,  NAVE,  and  RETURN.  A  modified 
version  of  the  main  routine  NAVE  is  also  included  as  NAVE 2 . 


EXSCC ,  INC.  '  B - 1 


it 


COPY99 

(PAGE  1  OF  2) 


INITIAL 
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000 1 
0002 
0003 
0004 
0005 
0006 

0007 
0008 
0009 
0010 
00 1 1 
0012 

0014 

0015 

0016 

2017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

003  9 

0040 

041 

2042 

004  3 


this  routine  Initializes  the  signal  measurement  data  base 
rea 1*4  evbuf(32),  rnaml<4),  rnam2(4) 

1nteger*4  ndsg,  nev,  tntev,  ndr,  mndr,  nfb 
logtcal*l  templ(4>,  temp2<4) 

equivalence  1 evbuf < 1  ) , ndsg > ,  ( evbuf ( 30 > , nxev ) ,  ( rnaml < 2 > .tempi > 
equivalence  < rnam2( 2 ) ,temp2 ) 

data  rnaml/'slgm' , '  1 , 1 . dat 1 ,0. / . rnam2/ 1 s 1 gm ' , '  1 i '•fre' . 

call  setfll  (  1, 'slgms.dlr' > 
defl.ne  file  1  (  32000 , 1 28  ,  u ,  nxrec  1  > 
call  setfll  (3, ' s Igmsd 1 r .f re ' ) 
define  file  3  ( 1 26 . 1024 , u , nxrec3 ) 
read  ( 1 ' 1 , end* 100 >  nev , 1 ntev , ndr , mndr 
If  (nev.eq.0)  go  to  100 

delete  event  data  files  and  freeblock  files 
nxev* 1 ntev 
do  10  k»  1  , nev 
read  (l'nxev)  evbuf 
encode  (4, 12, tempi)  ndsg 
1 2  format  (14) 

decode  (4, 14, tempi)  tempi 
encode  (4, 14, tempi)  tempi 

14  format  (411)  _ 

call  setfll  (2, rnaml, 64) 

define  file  2  ( 32000 , 256 , u , nxrec 2 ) 

endf  lie  2 

encode  <4,12,temp2)  ndsg 
decode  (4,14,temp2>  temp2 
encode  <4,14,temp2>  temp2 
call  setfll  (4,rnam2,64) 
define  file  4  ( 1 26 , 1024 , u , nxrec 4 ) 
endf lie  4 
10  continue 
100  continue 

Initial Ize  pointers 
nev*0 
1 ntev=0 
ndr*  1 

mndr*32000 

write  (l'l)  nev, Intev, ndr, mndr 
nf  b*0 

write  ( 3  '  1  )  nfb 
endf lie  1 
endf lie  3 
stop 
end 
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0001 
0002 
0003 
0004 
000 5 


0006 

0007 


0008 


0009 

0010 

0011 


0012 

0013 

0014 

0015 

0016 


0017 

0018 

0019 

0020 

0021 

0022 

0024 

0026 

0027 

0026 

0029 
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page  001 


c 

c 

c 

c 

c 


c 


c 


c 


c 


e 


this  routine  accesses  the  9-track  signal  measurement  tape 
and  does  the  necessary  conversions  and  reformatting  before 
supplying  the  Information  to  subroutine  update 
all  Info,  on  a  tape  for  an  event  should  be  consecutive 

rea 1*4  es 1nfo< 141 )  ,mslab( 62 ) , stanl 50 ) , headl 375 ) ,data< 100) 

Integer *4  ndsg, Idstat, levr, Istr, If lgev, If  1 gst , 1 ndsg , 1evorg(5) 

1 nteger*4  Idpth 
log1ca1*l  chbuf ( 1 500 ), temp 

equivalence  (eslnfol 1 > , ndsg  ),( es 1 nfo( 2 ) , levorg > , ( es 1 nfo( 7 ) .evlat ) , 
(eslnfol 8 > .evlon  ) ,  ( es 1 nf o( 9 > , evmb ) ,  < es 1 nfo< 10 >, Idpth ) , 

2  ( eslnfol 1 1 > , If lgev  ) , <  es 1 nf o< 1 2  ) , stat ) , < es 1 nf o< 1 3 ) , Idstat) , 

3  ( eslnfol 14  > , If lgst ) . (eslnfol 15  l.contr  )  ,<estnfo( 140) , levr  ), 

4  (eslnfol 141  ), Istr  ) 
equivalence  (chbuf, head) 


data 

1 

2 

3 

4 

5 

6 

7 

8 


' anmo ' 

'anto' 

, ’ boco ‘ 

,  ' chto ' , 

'  nors ' , 

'  gumo ' 

' ma 1 o ' 

*  1  asa 1 

, ‘ nwao ' 

, ' grf o  '  , 

'  sh 1o ' , 

'tato' 

' snzo ' 

1  1  1  pa  ’ 

. 'alpa ' 

,  '  ctao ' , 

'  zobo ' , 

'  kaao ' 

1 ma jo ' 

' kono ’ 

, ' bfak ’ 

,  'ctao ’ , 

1  chgo 1 , 

'  tnak ’ 

' t 1 oo ' 

‘  e 1 ao ' 

, ' kono ' 

, ' ogdo ' , 

1  k 1 po  '  , 

'  a  1 qo ' 

'  Z  1  po  ’ 

'  mato ' 

, 1 hnme ' 

,  ' rkon ' , 

'  ksrs ' , 

•atak ’ 

' ucak  * 

1  cnak ' 

, ' n jak  ' 

«  » 

'CS01 ' , 

1  cs02 ' 

' c  s03 ' 

' cs04 1 

, ' c  s05 ' 

, 'cs06  '  , 

’cs07 ' . 

'  c  s08 1 

2*’ 

V. 

contr/ ' 

ensc ’ / , 

1  ndsg/0/ 

data  nmeas/25/ ,  ms  1 ab/ ' ms01 ' , ' ms02 ' , ' ms03 ' , 1 ms04 ' , ' ms05 ' . 

1  1 ms06 ' , ' ms07 ' , ' ms08 ' ,  ' ms09 ' , ' ms  10 ' , ' ms  1 1 T 

2  'msl2' , 'msl3' , 'msl4‘ , 'msl5' , 'msl6' , ’ ms  1 7 ‘ , 

3  ' ms  1 8 ' , ' ms  1 9 ' , ' ms20 1 , 'ms21 ' , ' ms22 ’ , ' ms23 '  , 

4  ' ms24 ' , ' ms25  '  /  ,  blank/’  '/ 
data  eo1/'eoi0'/ 


common  /arg/  eslnfo 

common  /asvar/  nxrec 1 , nxrec2 , nxrec 3 , nxrec 4 

open  directory  and  directory  freeblock 
call  setfll  ( 1 , ' s 1 gms . d 1 r '  ) 
define  file  1  ( 32000 , 1 28 . u . nxrec 1 ) 
call  setfll  ( 3 , * s 1 gmsd 1 r . f re '  ) 
define  file  3  ( 1 26 , 1024 , u , nxrec 3 ) 

5  continue 

read  In  header 

1 un 1 t*0 

lenh«1500 

lend*400 

set  all  state  flags 
1  state«259 

call  Intape  ( 1 un 1 1 , head . 1 enh , 1 sw, 1  state ) 

If  (Isw.ne.l)  go  to  995 
If  (  lenh . ne . 80  )  go  to  7 
do  8  k* 1 . 4 

call  etoa  ( chbuf ( k  ), temp  ) 
chbuf ( k  ) “temp 
8  continue 
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0030  If  < headl 1 > .eq .eo< )  go  to  995 

0032  7  continue 

c  convert  ebcdlc  to  ascii 

c 

0033  do  10  k«29 , 1 500 

0034  call  etoa  < chbuf ( k  ) , temp ) 

0035  chbuf ( k )*temp 

0036  10  continue 

c 
c 

c  decode  site  number  and  use  to  obtain  station  name 

0037  decode  (4, 100, head)  Idstat 

0038  100  format  (66<4x>.<4> 

0039  stat*stan( Idstat ) 

c  decode  designation  number  and  check  to  see  If  It  Is  a  new  event 

0040  decode  (4,150,head)  ndsg 

0041  150  format  <ll(4x),14) 

c  check  to  see  If  event  Is  the  same  as  the  last  event 

0042  If  ( ndsg . eq . 1 nsdg )  go  to  50 

0044  lnsdg*ndsg 

0045  1flgev«l 

0046  1flgst*l 

c  decode  origin  time,  latitude,  longitude,  mb,  and  depth 

0047  decode  ( 20, 200, head >  levorg 

0048  200  format  ( 47<  4x  >  .5  1  4  ) 

0049  decode  (8, 300, head)  evlat 

0050  300  format  ( 33 < 4x  ) , f 8 . 3 > 

0051  decode  (0,350. head)  evlon 

0052  350  format  ( 55< 4x > ,f 8 . 3 ) 

0053  decode  <  4, 375, head)  Idpth 

0054  375  format  (57(4x),14) 

0055  decode  (4, 400, head)  evmb 

0056  400  format  < 58< 4x > ,f 4 . 2  ) 

0057  go  to  500 

0058  50  continue 

0059  1 f 1 gev*- 1 

c  note:  If  event  was  not  In  data  base  prl  <r  to  this  run, 

c  Iflgst  Is  changed  to  0  In  subroutine  update  since 

c  all  stations  will  be  new 

e 

c  read  in  data  and  convert  from  1 bm  360/44  to  pdp  11/70  floating  point 

c 

0050  call  Intape  ( 1 un 1 1 , data , 1  end , 1 sw, 1  state ) 

0051  If  (Isw.ne.l)  go  to  995 

0053  do  60  k«l,nmeas 

00 64  call  f360f  ( data( k ) , pdptm > 

0065  data ( k >«pdptra 

0066  60  continue 

c 

c  load  measurements  and  labels  (max.  of  62)  Into  argument  list 

0067  do  70  k«l,r.meas 

0058  1 1 ab» 1 4  +  k*2 

0069  es 1 nf o( 1 1 ab )*ms lab( k ) 

0070  1  ms* 1 1 ab* 1 

0071  es 1 nfo( 1ms >'data( k  ) 

0072  70  continue 

e  Insert  blank  after  last  measurement 
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0079 

00d0 

0081 
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0083 
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If  ( nmeas . ne . 62  )  es 1 nf o( 1 1ab*2 )*blank 
c 

500  continue 

cal  1  update  ( lerr  > 

If  (terr.eq.l)  go  to  995 
go  to  5 
995  endflle  1 
endflle  3 
stop 
end 
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0001  subroutine  update  Herr) 

c  this  routine  establishes  the  signal  measurement  data  base 
c  eslnfo  contains  pertinent  event-station  Info  and  flags 

c  1flgev«l  search  for  event 

c  1flgev»0  add  event 

c  1flgev«-l  update  previous  event 

c 

c  1f1gst»l  search  for  station 

c  1flgst*0  add  station 

c  1flgst«-l  update  previous  station 

c 

c  1err»0  no  errors 

c  1err*l  error  1 nestabl 1 sh 1 ng  data  base 

c 

c  logical  un1t«l  directory  file 

c  *2  event  data  file 

c  *3  freeblock  file  for  directory 

c  »4  freeblock  file  for  event  data  file 

c 

0002  rea1*4  es 1 nfo< 1 41 > ,meas( 2 , 62  ) , key ( 4 ) .dummy ( 20) ,dumy< 15 ) 

0003  rea 1 *4  dum(9),evbuf(32>,stbuf(32),msbuf(64),rnaml(4j,rnam2(4) 

0004  1  nteger*4  nev,1ntev,ndr,mndr,ndar.mndar,ndsg,1stev,nxev,nstat 

0005  1 nteger*4  1ntst,1dstat,ncon,lstst,nxst.1evr,1str,msrec,l stms 

0006  1nteger*4  nxms , nf b , 1 f rec , t f 1 gev , 1 f 1 gst , 1 evorgl 5 ) , tdpth 

0007  1og1cal*l  tempi ( 4 > , temp2( 4  ) 

0008  equivalence  (eslnfol 1 ),ndsg>,(es1r.fo(2>, 1evorg),(es1nfo(7),evlat), 

1  ( es 1 nf o< 8 ) , ev 1  on  ) ,  ( es 1 nf o< 9  ) , evmb  ) ,  1 es 1 nfo( 10 > , tdpth > , 

2  ( es 1 nf o( 1 1 > , If lgev > ,  ( es 1 nf o( 1 2 > . stat > ,  ( es  inf o( 1 3  ) ,  i dstat ) , 

3  ( es  1  nf o( 1 4  ) ,  if  1  gst > ,  ( es 1 nf o( 1 5  ) , contr  ) ,  ( es  1  nf o( 1 6  ) , meas  ) , 

4  ( es 1 nfo( 1 40 ) , levr  ) ,  ( es 1 nf o( 1 4 1 > , 1 str  ) 

0009  equivalence  ( evbuf ( 29  ) , 1 stev  ) , ( evbuf ( 30  ) , nxev  ) ,  < evbuf ( 3 1 ) , nstat ) , 

1  ( evbuf ( 32 >, 1 ntst > ,  < stbuf ( 1 8  ) , 1 stst > ,  ( stbuf ( 1 9  ) , nxst ; , 

2  ( stbuf(20).ncon) 

0010  equivalence  ( rnaml ( 2 ) , tempi ) .  < rnam2 ( 2 > , temp2  ) 

0011  data  blank/'  '/.  dummy/20»0. / ,  dumy/15«0./,  dum/9*0./ 

0012  data  rnaml /’ s 1 gm 1  ' , 1 . dat ’ ,0. / , rnam2/ 1 s i gm ' , '  ',‘.fre',0./ 

0013  common  /arg/  eslnfo 

0014  common  /asvar/  nxrec 1 , nxrec2 , nxrec3 . nx rec4 

c 

c  construct  event  file  and  freeblock  names  and  open  files 

0015  encode  (4, 6, tempi)  ndsg 

0016  6  format  (14) 

0017  decode  (4, 7, tempi)  tempi 

0018  encode  ( 4 , 7 , tempi  )  tempi 

0019  7  format  (411) 

0820  encode  (4,6,temp2)  ndsg 

0021  decode  (4,7,temp2)  temp2 

0022  encode  (4,7,temp2)  temp2 

0023  call  setf 1 1  (2, rnaml) 

0024  define  file  2  ( 32000. 256 , u . nxrec2 > 

0025  call  setfll  (4,rnam2> 

0026  define  file  4  ( 1 26 . 1024 , u . nxrec 4 > 

c 

0027  1err«0 

002J  read  (1*1)  nev , 1 ntev . ndr . mndr 

0029  if  ( If lgev.eq.-l >  go  to  150 

0031  If  !  If Igev.eq. 1  )  go  to  100 


» 
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0033 

0034 

0036 

0038 

0339 

0.340 

0041 

0043 

0045 
004  6 
004  7 
004  8 
0049 
0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0050 

0061 

0062 
006  3 
0064 
0066 
0057 
0058 
0070 
0072 

0073 

0075 

0076 

0078 

0030 

0031 

0032 

0033 

0035 

0037 

0038 

0039 


1  continue 

c  add  new  event  to  data  base  (at  top  of  list) 

If  ( ndr .ge.mndr >  go  to  995 
If  (nev.ne.0)  read  (l'lntev)  evbuf 
call  chkfre  ( 3 ,0, nf b , 1 f rec ) 
c  modify  backward  pointer  of  old  event 

ndr=ndr+ 1 
1 stev*ndr 

If  <nfb.gt.0)  lstev»1frec 
If  ( nev.ne.0)  write  (l'lntev)  evbuf 
c  reset  Intev  and  appropriate  pointers  In  new  event 

nxev* 1 ntev 
1 ntev* 1 stev 
1 stev*0 
nstat*0 
1 ntst*0 

write  (l'lntev)  ndsg , 1 evorg , evl at , ev Ion ,evmb , 1 dpth .dummy , 
1  1 stev , nxev , nstat , 1 ntst 

levr* 1 ntev 
nev=nev+ 1 

write  (l'l)  nev, Intev, ndr, mndr 
c  Initialize  data  file 

nda  r* 1 
mnda  r*32000 
write  (l'l)  ndar.mndar 
c  Initialize  freeblock 

nf  b*0 

write  ( 4  '  1  )  nf b 

c  set  station  flag  to  add  stations 
If 1gst*0 
go  to  150 
100  continue 
c  search  for  event 

key< 1  )*ndsg 

call  search  ( 1 , key , 1 evr , 1 str , Icon , ms rec , ms  1 nd , 1 srch > 

If  (isrch.eq.l)  go  to  1 

150  continue 

read  (l'levr)  evbuf 

If  <  If lgst.eq.-l >  go  to  250 

If  ( If lgst.eq. 1  )  go  to  200 

151  continue 

c  add  new  station  to  top  of  list 

If  ( ndr . ge . mndr )  go  to  995 

c  check  to  see  If  there  Is  room  In  the  data  file 

read  (2'1)  ndar.mndar 
If  ( ndar . ge . mrda r  )  go  to  995 
If  (nstat. ne.0)  read  (l'intst)  stbuf 
call  chkfre  ( 3 , 0, nf b , 1 f rec  ) 
c  modify  backward  pointer  of  old  station 

ndr*ndr+ 1 
1 stst*ndr 

If  (nfb.gt.0>  lstst*1frec 
If  (nstat. ne.0>  write  (l'intst)  stbuf 
c  reset  1n^st  and  appro,  pointers  In  new  station 

nxst*  1  ntst 
1 ntst* 1 stst 
1 stst*0 


ENSCO,  INC. 


B  -  9 


DDBASE 

(PAGE  6  OF  11) 


UNIX 

2292 

0091 

0092 

0093 

2295 

0096 

0097 

0096 

0100 

0101 

0102 

0103 

0104 

0106 

0107 

0106 

0110 

0112 

0113 

0114 

0115 

0117 

0116 

0119 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0126 

0129 

0130 

0131 

0132 

0133 

0134 

0136 

0137 

0136 

0139 

0140 

0142 

2144 

2145 

2146 

2147 

2148 

2149 
2151 
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nstat»nstat*l 
write  (l'levr)  evbuf 
c  count  measurements 

do  12  k-1,62 

If  ( measi 1 , k  )  .eq . blank  )  go  to  15 
12  continue 
nmeas*k 
15  continue 

If  <k.ne.62)  nmeas*k-l 
ncon»l 

call  chkfre  ( 4 ,2, nf b , 1 f rec > 

ndar*ndar+l 

msrec-ndar 

If  <nfb.gt.2)  msrec“1frec 

1 stms*2 

nxms»2 

If  < nmeas  .  It .  31 >  go  to  20 
If  ( ndar .ge.mndar  )  go  to  995 
call  chkfre  ( 4 ,2 , nf b , 1 f rec  ) 
ndar«ndar+l 
nxms*nda  r 

If  <nfb.gt.2)  nxms*1frec 
22  continue 

write  (2'msrec)  ( ( meas(  1 . j  ) , j  =  l , 31 > , 1 -2 , 1 , - 1  ) , 1 stms , nxms 
If  ( nmeas . It. 31  )  go  to  25 
lstms*msrec 
nu 1 1 *2 

write  ( 2 ' nxms  )  ( (  meas< 1 , j > , j  =  32 , 62 ) ,  1 «2 , 1 , -1  ) , 1 stms , nu 1 1 
25  continue 

write  (l'lntst)  stat , 1 dstat , dumy , 1 stst . nxst , neon , contr , msrec , 
1  nmeas.dum 

write  (l'l)  nev , 1 ntev , ndr ,mndr 
write  (2'1)  ndar.mndar 
endflle  2 
endf 1 1 e  '  4 
return 

200  continue 

search  for  station 
key <  2  >«stat 

call  search  < 2 . key , 1 evr , 1 str , 1  con , msrec , ms  1 nd , 1 sr ch > 

If  (Isrch.eq.l)  go  to  151 
cont 1 nue 

read  < 1 ' 1 str  )  stbuf 
search  for  contractor 
key ( 3 )*contr 

call  search  ( 3 , key , 1 evr , 1 str , 1  con , msrec , ms  1 nd , 1 srch > 

If  <1srch.eq.2>  go  to  320 
c  add  nev/  contractor  block  If  there  Is  room 
If  <ncon.lt. 4)  go  to  52 
write  (6.30) 

32  format! '  all  possible  contr.  blocks  already  full') 
go  to  997 
52  continue 

c  count  measurements 

do  60  k*l .62 

If  < mea s ( 1 , k  ) . eq . b 1 ank  )  go  to  65 
62  cont 1 nue 


c 


252 

e 
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nmeas*k 
65  continue 

If  (k.ne.62)  r.meas*k-l 

ncon«ncon*l 

read  (2*1)  ndar.mndar 

If  < ndar .ge.mndar  )  go  to  995 

call  chkfre  <  A  ,0,  nf  b ,  1  f  rec  > 

ndar«ndar*l 

msrec«ndar 

If  ( nf b . gt . 7 >  msrec" If rec 

1 stms"0 

nxms-0 

If  ( nmeas . 1 t . 3 1 >  go  to  70 
If  ( ndar .ge.mndar  )  go  to  995 
call  chkfre  < 4 .0, nf b , If rec ) 
ndar»ndar*l 
nxms*nda  r 

If  (nfb.gt.0)  nxms* 1  free 
70  continue 

write  <  2 ' msrec  /  ( ( meas< 1 , J ) , J"1 , 3 1 ) , 1  2 , 1 , -1 ) , 1 »tm» , nxms 
If  ( nmeas . It . 31 )  go  to  75 
1 stms"msrec 
nu 1 1 *0 

write  (2'nxms)  ( ( meas< 1 , j  ) , j -32 , 62 > , 1 *2 , 1 , -1  ) . 1 stms . nul 1 
75  continue 

store  contractor  Info 

1c"21+3*(ncon-l ) 

stbuf ( ic  )«contr 

stbuf ( lc  +  1  )»msrec 

stbuf  <  tc  +  2  >»nmeas 

write  (l'lstr)  stbuf 

write  (l'l)  nev , 1 ntev , ndr ,mndr 

write  <  2  •  1  >  ndar.mndar 

endflle  2 

endf  1 1e  '4 

return 

300  continue 

loop  over  measurements - searching  and  updating 

do  90  k«l ,62 

If  ( meas( 1 , k ) .eq . blank )  go  to  999 
key( 4  )*meas( 1  ,k  ) 

call  search  < 4 , key . levr , 1 str , 1  con . ms rec , ms  1 nd , 1 srch ) 

If  <  1  srch .eq . 1  )  go  to  80 
read  (2’msrec)  msbuf 
msbuf <  ms  1 nd  )»meas( 2 , k ) 
write  (2'msrec)  msbuf 
go  to  90 
80  continue 

when  measurement  not  found,  msrec  Is  last  meas.  record 

ms  1  nd  =  mod ( nmeas, 31 )  +  l 

read  (2 ‘msrec)  msbuf 

If  ( ms  1 nd . 1 e . 3 1 )  go  to  85 

If  < ndar . ge.mndar )  go  to  995 

ms  I  nd» 1 

call  chkfre  ( 4 , 0, nf b , I f rec ) 

ndar»ndar*l 

nxms«ndar 
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0001 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


0002 
0003 
0004 
000 5 
0006 

0007 
0008 
0009 
001 1 
0012 
0013 

0015 
0016 
0017 
0016 
0015 
0021 
0022 
0023 
0024 
00 25 
0026 
0027 
0029 
0030 

0031 
0033 
0034 
0036 
0037 
0038 
0039 
0040 
0041 
0043 
004  4 
0045 


subroutine  search  < If lag, key, evrec, strec, ieon.msree.mslnd, Isrch) 
this  routine  searches  for  a  specific  keyword  and  returns  the 
appropriate  record  and/or  Index 


If lag«0 
If lag"l 
if  1 ag*2 
If lag*3 
If lag«4 

( returns 


full  search  (needs  all  keys) 
search  for  event 

search  for  station  (needs  evrec) 
search  for  contractor  (needs  strec ) 
search  for  measurement  (needs  Icon) 
rec  *  In  's1gmxxxx.dat'  and  Index  Into 


rec  ) 


100 


10 

14 


15 


200 


201 


20 

24 


key( 1  )"event  designation 
key( 2 )*stat1on  name 
key ( 3  )"contractor  name 
key! 4  )«measurement  mnemonic 
1srch«0  successful  search 
1srch=l  unsuccessful  search 

1 nteger*4  nev , 1 ntev , ndr ,mndr .evrec , strec , ms rec , nmeas 
1 nteger*4  ndsg  .  nxev , ns tat , 1 ntst ,nxst , nxms , 1contr( 12 ) 
real*4  key ( 4  ) , buf f ( 32 ) .msbuf f  (  64 ) 

equivalence  ( buf f ( 1 >, ndsg , stat > ,  ( buf f ( 1 9 ) . nxst ) ,  (  buf f  (  30 ) , nxev ) 
equivalence  ( buf f ( 3 1 > , nstat > .  (  buf f  (  32 ) , 1 ntst > .  ( msbuf f( 64 ). nxms > . 
1  ( buff ( 21 > . Icontr ) 

common  /asvar/  nxrec 1 , nx rec2 . nxrec 3 , nxrec 4 
1 srch"0 

If  (lflag.eq.0)  go  to  100 

go  to  (100,200.300.400),  If  lag 

read  (l'l)  nev , 1 ntev , ndr , mndr 

If  (nev.eq.0>  go  to  995 

search  through  events 

nxev" 1 ntev 

do  10  k" 1 , nev 

evrec"nxev 

read  (  1  '  nxev  )  buff 

If  (  keyf'l  )  .eq. float!  ndsg  >  )  go  to  15 
cont 1 nue 

write  (6,14)  key ( 1 > 

format( '  events  ,,f4.0,'  not  found 1  ) 

1 srch" 1 
go  to  999 
cont 1 nue 

If  ( 1 f 1 ag . eq . 0 )  go  to  201 

return 

continue 

search  through  stations  given  base  vector  (event)  record  • 

If  (evrec. eq.0)  go  to  995 
read  (1 'evrec)  buff 
If  (nstat. eq.0)  go  to  995 
kount»nstat 
nxst"  1  ntst 
do  20  k" 1 , kount 
strec«nxst 
read  <  1  '  nxst )  buff 
If  ( key ( 2  ) . eq . stat ) 
cont 1 nue 

write  (6.24)  key  <  2  ) 
format! ‘  station: 


go 


to  25 


.  a4  , 


not  found '  ) 
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0046  1sreh-l 

0047  go  to  999 

0048  25  continue 

0049  If  (1flag.eq.0)  go  to  301 

0051  return 

0052  300  continue 

c  search  station  record  for  contractor  Index 

0053  If  (strec.eq.0>  go  to  995 

0055  read  ( 1 ' strec  )  buff 

0056  301  continue 

0057  do  30  icon-21,30,3 

0058  If  < key < 3  ) .eq . buf f ( Icon ) )  go  to  35 

0060  30  continue 

0061  write  (6,34)  key(3) 

0062  34  format!'  contractor:  •.34,'  not  found') 

0063  1srch-l 

0064  go  to  999 

0065  35  continue 

0066  If  ( 1 f 1 ag . eq .0 )  go  to  400 

0058  return 

0069  400  continue 

0070  1off-1con-20 

0071  msrec *  1 contr ( lof f ♦ 1 ) 

0072  nmeas- tcontr( lof f *2  ) 

0073  If  (nmeas. eq.0)  go  to  995 

0075  nblk-nmeas/31+1 

0076  If  (  mod(  r.mea  s  ,  3 1  ) .  eq  .0 '  nblk*nblk-l 

0078  nxms-msrec 

0079  do  45  n«l,nblk 

C  set  msrec  to  current  rec  # 

0030  msrec-nxms 

0081  read  ( 2 ' nxms  )  msbuff 

c  search  through  measurement  mnemonics 

0082  do  40  k-,32.62 

0083  If  ( key ( 4  ). eq . msbuff ( k ) )  go  to  50 

0085  40  continue 

0086  45  continue 

0037  write  (6,45)  key(4> 

0038  46  format!'  measurement:  ',a4,'  not  found') 

0089  1srch»l 

0090  go  to  999 

0091  50  continue 

0092  mslnd-k-31 

0093  go  to  999 

0034  995  write  (6.996  ) 

0095  996  format!'  error  on  search') 

0096  stop 

0897  999  return 

0098  end 
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0001 


0002 
0003 
0004 
000 5 
0007 
0008 
0010 
0011 
0013 
0014 
0016 
0017 
0018 
0019 

0020 

0021 

0023 

0024 

0025 

0026 

027 

0028 

0029 


subroutine  chkfre  ( lunlt, If lag.nfb, Ifrec > 
this  subroutine  checks  the  appropriate  freeblock  file  and 
returns  the  total  of  free  blocks  before  this  call  and 
the  next  free  record 

1flag«0  returns  free  record  In  Ifrec 

lflag'1  freeblock  extended  with  Ifrec 

1 nteger*4  nf b, nnf b, (free , f reb( 256 ) 
common  /asvar/  nxrec 1 , nxrec2 , nxrec 3 , nxrec 4 
read! 1 un It ' 1  )  nf b 

If  ( nf b . eq .0. and . If  1 ag . eq .0 )  return 
1recfb«nfb/256+2 

If  < mod( nf b , 256 > . eq .0 >  1  reef b« 1  reef b- 1 
read  < 1 un 1 1 ' 1  reef b  )  freb 
If  (Iflag.eq.l)  go  to  10 
1 nd*mod<  nf b . 256  > 

If  (1nd.eq.0)  1nd“256 
1 f  rec *f  reb< 1 nd  ) 
nnfb«nf b-1 
go  to  20 
10  continue 

find  next  freeblock  entry 
1 nd*mod( nfb, 2561+1 
If  ((nd.eq.l)  1  reef b* 1  reef b+ 1 
f reb< 1  nd  )■ Ifrec 
nnf b*nf b+ 1 

write  < 1 un It ' 1  reef b  )  freb 
20  continue 

modify  freeblock  header 
write  ( lunlt' 1  )  nnfb 
return 
end 
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c  this  routine  performs  a  network  average  for  the  first 

c  ' nd 1  sc '  discriminants  for  each  station  for  a  given  event 

c 

0001  real *4  stat ,contr ,ms lab, rmeas( 100) , r 1 ab< 100 ) .evbuf ( 32  ) , stbuf <  32 ) 

0002  real*4  key(4),  rmx(650),  d1scr(100) 

0003  1 nteger*4  ndsg . nret , 1 evr , 1 ntst . nxst , 1 str .msrec , nstat 

c  equivalence  < evbuf ( 32  ) , 1 ntst ) , ( evbuf ( 3 1 > , nstat > ,  ( stbuf < 19 >, nxst), 

c  1  ( stbuf ( 1 > , stat  > 

0004  data  contr/ ' ensc ' / ,  rmx/uS0*0./ 

c 

0005  common  /flags/  If Igms , If lgev 

0006  common  /asvar/  nxrec 1 , nxrec2 , nxrec3 , nxrec4 

c 

0007  call  setftl  ( 1 , ' s Igms .d 1 r 1  ) 

0003  define  file  1  ( 32000, 1 28 , u , nxrec 1 > 

e  #  of  discriminants  to  average 

0009  nd 1  sc  «2 1 

0010  write  (6, 100) 

0011  100  format  input  event  designation  *,  (14)') 

0012  read  (5,150)  ndsg 

0013  150  format  (14) 

0014  key( 1 >“ndsg 

0015  call  search  ( 1 , key . 1 evr , 1 str , 1  con , msrec , ms  1 nd , 1 srch ) 

0016  If  (Isrch.eq.l)  go  to  999 

0018  read  (l'levr)  evbuf 


5' 

; 


0019  lflgns*0 

0020  1  f 1 cev* 1 

0021  nxst“1r.tst 

0022  do  10  k*l, nstat 

0023  read  (l'nxst)  stbuf 

0024  call  access  ( ndsg , stat .contr , ms  1 ab , nret , rmeas , r 1 ab , tevr ) 

C  load  matrix  with  measurements 

0025  do  20  j»  1  ,  nd 1  sc 

0026  1 nd” j  +  ( k- 1  )*nd 1  sc 

0027  rmx<  1 nd >  =  rmeas( j  ) 

0028  20  continue 

0029  10  continue 

c 

c  convert  from  integer*4  to  1nteger*2 

0030  nsta_nstat*l 

0031  call  mblas  ( rmx , nsta , nd 1  sc ,d 1  sc r ) 

0032  write  (6,200)  ( r 1 ab( 1 > , d 1 scr ( 1 > , 1  *  1 , nd 1  sc > 

0033  200  format  (20(5(a4,'  :  ' ,f7 . 3 , 5x  )/ > > 

0034  999  endflle  1 

0035  stop 

0036  end 
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0016 
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0025 
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0030 
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0033 
0034 
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0037 
0038 
0039 
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004  4 
0045 
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subroutine  search  < if  lag, key, evrec, strec, icon .msrec ,ms 1 nd , isrch) 
c  this  routine  searches  for  a  specific  keyword  and  returns  the 
c  appropriate  record  and/or  index 
c 

c  1flag»0  full  search  (needs  all  keys) 

c  1flag«l  search  for  event 

c  1flag*2  search  for  station  (needs  evrec  ) 

c  1flag«3  search  for  contractor  (needs  strec  ) 

c  1flag*4  search  for  measurement  (needs  icon) 

c  (returns  rec  #  in  'sigmxxxx.dat'  and  Index  tnto  rec > 

c  key< 1  )*event  designation 

c  key ( 2  )“stat ( on  name 

c  key ( 3  )*contractor  name 

c  key ( 4 > *mea su rement  mnemonic 

c  1srch*0  successful  search 

c  1srch«l  unsuccessful  search 

c 

1nteger*4  nev,  in  tev,ndr,mndr,  evrec,  strec,  msrec,  nir.eas 
i nteger*4  ndsg,nxev,nstat,1ntst,nxst,nxms, 1 cont r ( 12 ) 
real *4  key ( 4  )  .buff ( 32  > .msbuff ( 64  > 

equivalence  ( buf f ( 1  ) , ndsg , stat ) ,  ( buf f ( 1 9  ) , nxst ) ,  ( buff ( 30) , nxev ) 
equivalence  ( buf f ( 3 1  ) , nstat ) ,  ( buff ( 32 ) , 1 ntst ) ,  ( msbuff ( 64 ), nxms ) , 
1  ( buff ( 21 ) , icontr ) 

common  /asvar/  nxrec 1 . nxrec2 , nxrec3 , nxrec 4 
1  srch«0 

if  (1flag.eq.0>  go  to  100 
go  to  (100,200.300.400),  if  lag 

100  read  (l'l)  nev , 1 ntev , ndr ,mndr 
if  (nev.eq.0)  go  to  995 
c  search  through  events 

nxev* intev 
do  10  k»l ,nev 
evrec*nxev 
read  ( 1 ' nxev  )  buff 

if  ( key ( 1  ). eq . f loatf ndsg ) )  go  to  15 

10  continue 

wr  ite  (6,14)  key( 1  ) 

14  format( ’  event:  ,,f4.0,•  not  found') 
i  srch» 1 

go  to  999 

15  continue 

if  (  if lag.eq.0>  go  to  201 
return 

200  continue 

c  search  through  stations  given  base  vector  (event)  record  # 
if  (evrec. eq.0)  go  to  995 
read  (l'evrec)  buff 

201  If  (nstat. eq.0)  go  to  995 
kount=nstat 

nxst” 1 ntst 
do  20  k« 1  ,  kount 
strec*nxst 
read  ( 1  '  nxst )  buff 
if  ( key< 2 > .eq . stat )  go  to  25 
cont i nue 

write  (6.24)  key ( 2  > 

format! '  station:  ',a4,‘  not  found') 


20 

24 
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0046  tsrch'l 

0047  go  to  999 

0048  25  continue 

0049  If  (tflag.eq.0)  go  to  301 

0051  return 

0052  300  continue 

c  search  station  record  for  contractor  Index 

0053  If  <  strec . eq . 0 )  go  to  995 

0055  read  ( 1 ' strec  )  buff 

0056  301  continue 

0057  do  30  1con»21.30,3 

0058  If  ( key ( 3  )  .eq . buf f ( Icon  )  >  go  to  35 

0060  30  continue 

0061  write  (6,34)  key<3> 

0062  34  format! '  contractor!  ',a4,‘  not  found  ) 

0063  1srch“l 

0064  go  to  999 

0065  35  continue 

0066  If  <lflag.eq.0>  go  to  400 

0068  return 

0069  400  contt-.ue 

0070  1  of  f* 1  con-20 

0071  msrec« Icontr! 1off+l ) 

0072  nmeas* Icontr! lof f +2 > 

0073  If  ( nmeas .eq .0)  go  to  995 

0075  nbl k«nmeas/3 1 ♦ 1 

0076  If  ( mod( nmeas . 3 1 > . eq .0 )  nb1k*nblk-l 

0078  nxms=msrec 

0079  do  45  n«l,nblk 

c  set  msrec  to  current  rec  # 

0080  msrec-nxms 

0081  read  ( 2 ' nxms  )  msbuff 

c  search  through  measurement  mnemonics 

0032  do  40  k*32,62 

0033  If  ( key( 4 > .eq .msbuff ( k >  )  go  to  50 

0085  40  continue 

0086  45  continue 

0087  write  (6,46)  key<4) 

0083  46  format! '  measurement!  ,,a4,'  not  found  ) 

0085  1srch»l 

0390  go  to  999 

0091  50  continue 

0092  ms1nd*k-31 

0093  go  to  999 

0394  995  write  (6,996) 

0095  996  format! '  error  on  search1) 

0096  stop 

0097  999  return 

0098  end 
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0001  subroutine  access  < ndsg , stat ,contr ,msl ab, nret , rmeas . r lab, levr ) 

c  this  routine  accesses  the  signal  measurement  data  base 
c  ndsg*event  designation  9 

c  stat^statlon  name  (If  ■  **•••', given  measurement  Is  returned  for  all 

c  stations  for  event) 

c  contr«contractor  name 

c  1flgms«0  return  all  measurements  for  station  (In  rmeas)  with  assoc. 

c  labels  (In  rlab) - warning:  It  should  be  noted  that 

c  there  Is  no  guarantee  all  the  meas.  will  be  In  the  same 

c  order  across  stations 

c  1flgms»l  return  only  Indicated  measurement 

c  mslab»label  of  desired  measurement 

c  nret«#  of  measurements  returned 

c  rmea s *mea su rement  values 

c  r 1 ab-assoc 1 ated  measurement  labels 

c  1flgev«0  search  for  event 

c  1f1gev»l  use  previous  or  supplied  event  record  #  (levr) 

c  1evr»event  record  # 

c 

0002  rea 1 *4  stat,contr,mslab, rmeas! 1 ),rlab( l),evbuf(32),stbuf(32> 

0003  rea  1  *4  buf f ( 64  ) , key ( 4  ) , rnaml ( 4  ) 

0004  1 nteger*4  ndsg , levr , 1 str .msrec , nxms , ns tat , 1 ntst , nxst , Icontr! 12 ) 

0005  IntegerM  nret 

0006  loglcal'l  templ(4> 

0007  equivalence  ( evbuf ( 3 1  ) , nstat ) , ( evbuf ( 32  ) , 1 ntst ) ,  ( stbuf ( 19 ) .nxst ) , 

1  ( buf f ( 64  ) , nxms > ,  ( stbuf ( 21  ), Icontr ) 

0008  equivalence  ( rnaml ( 2 >, temp  1  ) 

0009  data  rnaml / 1 s 1 gm 1  ' , ' .dat ' ,0. / ,  star/'****'/ 

0010  common  /flags/  1 f 1 gms , 1 f 1 gev 

0011  common  /asvar/  nxrec 1 , nxrec2 , nxrec 3 . nxrec 4 

c 

c  construct  data  file  name  and  open  file  (directory  file  should  already  be 

c  open) 

0012  encode  (4,1, tempi)  ndsg 

0013  1  format  (14) 

0014  decode  (4, 2, tempi)  tempi 

0015  encode  (4, 2, tempi)  tempi 

0016  2  format  (411) 

0017  call  setfll  (2, rnaml) 

0018  define  file  2  ( 100 , 256 , u , nxrec2 ) 

c 

0019  nret»0 

0020  key(l)«ndsg 

0021  key(3)"contr 

0022  If  ( if lgev.eq.0)  call  search  ( 1 , key , 1 evr , 1 str , Icon , msrec ,ms 1 nd , 

1  Isrch) 

0024  If  ( If lgev . eq .0.and . 1 srch . eq . 1 )  go  to  995 

£026  If  ( stat. eq. star  )  go  to  500 

c  search  for  specified  station 

0028  key(2)*stat 

0029  call  search( 2 .key , levr , i str , icon .msrec , ms  1 nd , 1 srch ) 

0030  If  (Isrch. eq.l)  go  to  995 

e  search  for  contractor  Index 

0032  call  search  ( 3 . key , 1 evr , 1 str , icon , ms rec , ms  1 nd , 1 s rch ) 

0033  If  (Isrch. eq.l)  go  to  995 

0035  If  ( If lgms.eq. 1  )  go  to  30 

e  return  all  measurements  for  station 
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0037 

0038 

0039 

0040 

0041 

0042 

0044 

0045 

0046 

0047 

0048 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 

0059 

0060 

0062 

0063 

0064 

0065 

0066 

0367 

0358 

0069 

0070 

0071 

0072 

0073 

0074 

0076 

0077 

0079 

0030 

0081 

0082 

0083 

00C4 

0085 


read  <1*1  str  )  stbuf 
1off»1con-20 
msrec'lcontrl 1off*l > 
nret.»  Icontrl  1off*2) 
nbH.snr*t/31  +  l 

If  <  mod(  r.ret  ,31  )  .eq  .0 )  nblk-nblk-1 

nxms*msrec 

do  10  n»l ,nblk 

read  (2'nxms)  buff 

1 1m*nret-<  n- 1  )*3 1 

If  ( 1 1m.gt.31)  1 1m»31 

do  20  k*  1  , 1 1 m 

1 st*( n- 1 >  *  3 1 ♦ k 

rmeas( 1st)*buff(k) 

rlab( Ist)“buff1k+31  ) 

20  continue 
10  continue 
go  to  995 
30  continue 

key < 4  ) ‘ms lab 

call  search  < 4 , key , 1 evr , 1 str . 1  con .msrec , ms  1 nd , 1 srch ) 
if  (Isrch.eq.l)  go  to  995 
read  (2’msrec)  buff 
nret» 1 

rmess(nret)*buff(ms1nd) 
go  to  995 
500  continue 

c  return  one  measurement  for  all  stations  across  event 

key ( 4  )*ms lab 
read  (l'ievr)  evbuf 
nxst«  1  ntst 
do  40  k«l,nstat 
1 str*nxst 

read  (l'.nxst)  stbuf 
c  search  for  contractor  Index 

call  search  ( 3 , key . 1 evr . 1 str , 1  con , msrec , ms  1 nd , ' srch ) 
If  <1srch.eq.li  go  to  40 
e  search  for  measurement 

call  search  < 4 , key . levr . 1 str , 1  con . msrec . ms  1 nd , 1 s rch ) 
If  <1srch.eq.l>  go  to  40 
read  (2'msrec)  buff 
nret»nret+ 1 

rmeas(nret)*buff(msind) 

40  continue 
995  endflle  2 
return 
end 
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page  00  1 


eaz  i 


0002 

0003 


0004 
0006 
0007 
0008 
0009 
0010 
001  1 
0012 
0013 
0014 
0015 
0015 
0017 


0018 

0019 

0020 

0021 

0822 


0023 

0024 


002  5 
0026 
002  7 
0023 
0029 
3330 
0031 


subroutine  mblas  (rmx,  nsta,  ndlsc,  dlscr) 

rmx  -  vector  length  >»  nsta*nd1sc 

contains  the  discriminants  (measured) 
nsta  -  number  of  stations  (must  be  <«  50) 
ndlsc  -  number  of  discriminants 
dlscr  -  unbiased  discriminant  output 
vector  length  >■  ndlsc 

this  routine  performs  rlngdahl's  maximum  likelihood 
estimating  technique  for  network  averaging 


rea.l  rmx(l>,  dlscr(l) 

common  /  svsto  /  nstat,  ndet(50), 

1  xmag(50>,  sdno1s(50) 

check  number  of  stations 

If  (nsta. le. 50)  go  to  2 
write  (6.3) 

3  format  ('  maximum  #  of  stations  (50)  exceeded') 

go  to  99 
2  continue 

nstat»nsta 
xbias  ■  1000.0 

s  1  gm  1  n  •  0 . 2  _ 

s Igmax  >1.0 
do  5  1  *  1 ,  50 
sdno(s( 1 >  •  0.1 
5  continue 

do  10  1  ■  1 .  ndlsc 

Initialize  signal  average 

nn  «  0 
ns  «  0 
nave  *  0 
sigmag  ■  0.0 

do  20  j  •  1,  nsta 

get  discriminant  measurement 

xmag(j)  *  rmx ( 1 ♦ ( j - 1 ) *nd 1  sc ) 

If  <  xmag(j)  )  30,  40,  50 

noise  measurement---get  rid  of  bias 

30  continue 

nn  •  nn  ♦  1 

xmagfj)  *  xmag(j)  ♦  xbias 
sigmag  «  sigmag  ♦  xmag(J) 
nave  *  nave  ♦  1 
ndet( j  )  •  0 
go  to  20 
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c 

Ignore  station 

0032 

w 

40 

cont  tnue 

0033 

ndet  (  J  )  ■  -1 

0034 

go  to  20 

C 

c 

signal  mcasurement---get  rid  of  bias 

0035 

c 

50 

cont 1 nue 

0036 

ns  ■  ns  ♦  1 

0037 

xmag(j)  ■  xmag(j)  -  xbias 

0038 

slgmag  •  slgmag  ♦  xmag(j) 

0039 

nave  *  nave  ♦  1 

0040 

ndet(J)  -  1 

0041 

20 

cont 1 nue 

c 

c 

starting  estimate  Is  average  signal  measurement 

0042 

c 

If  (  nn  .eq.  0  .or.  ns  .ne.  0  )  go 

to  60 

004  4 

smax  »  -1000.0 

004  5 

do  70  j  »  1,  nsta 

0046 

If  (  ndet(j)  .ne.  0  .or.  smax  .gt. 

xmag<  j  ) 

0048 

smax  *  xmagf J  > 

0049 

Indx  »  j 

0050 

70 

cont 1 nue 

0051 

ndetl 1 ndx  )  ■  1 

0052 

ns  «  1 

0053 

60 

cont 1 nue 

0054 

If  (  ns  .ne.  0  )  go  to  80 

0056 

slgmag  •  0.0 

0057 

go  to  90 

0058 

80 

cont 1 nue 

0059 

sds 1 g  •  0.35 

0050 

slgmag  •  s 1 gmag/f 1oat< nave ) 

0051 

call  max2d  (slgmag,  sdslg,  slgmln, 

s 1 gmax  ) 

c 

c 

store  unbiased  discriminant  Into  output 

.  array 

0062 

c 

90 

cont 1 nue 

0053 

dlscrt 1  )  *  slgmag 

0054 

10 

contl nue 

0065 

c 

99 

continue 

0066 

c 

return 

0067 

c 

end 
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page 

0001 

subroutine  max2d  (x,  y,  slgmln,  slgmax) 

0002 

c 

real  llkell 

0003 

c 

real  z <  5  > 

0004 

c 

niter  »  0 

0005 

nloop  *  0 

0006 

deltax  >  0.09 

0007 

deltay  »  0.09 

0008 

c 

10 

continue 

0009 

z ( 1  )  *  llkell  ( x ,  y  ) 

0010 

z(2)  *  llkell  (x+deltax. 

y) 

001 1 

i(3)  “  llkell  (x-deltax, 

y  > 

0012 

yhl  *  y  ♦  deltay 

0013 

If  (  yhl  .gt.  slgmax  >  yhl  •  slgmax 

0015 

2(4)  «  llkell  (  x ,  yhl) 

0016 

If  <  ylo  .It.  slgmln  )  ylo  «  slgmln 

0018 

ylo  »  y  -  deltay 

0019 

z<  5  >  ■  llkell  (x,  ylo) 

0020 

niter  ■  niter  ♦  1 

0021 

id  1 r  *  1 

0022 

zmax  ■  z< 1 > 

0023 

do  20  1  »  2.  5 

0024 

If  <  2(1)  .It.  zmax  >  go 

to  20 

0026 

zmax  «  z(1) 

0027 

1  d  1  r  ■  1 

0028 

20 

cont 1 nue 

0029 

c 

If  (  Idlr  .eq.  1  )  go  to 

30 

0031 

if  ‘  Id  1 r  .eq .  2  )x-x 

♦  deltax 

0033 

if  (  tdtr.eq.3  )x«x 

-  deltax 

0035 

if  (  idir  eq.  4  )  y  ■  y 

♦  deltay 

0037 

if  '(  idir  .eq.  5  )  y  ■  y 

-  deltay 

0039 

if  (  y  .gt.  sigmax  >  y  * 

s  i  gmsx 

0041 

if  (  y  -It.  sigmin  )  y  ■ 

sigmin 

0043 

if  (  niter  .gt.  100  )  return 

0045 

go  to  10 

0046 

c 

30 

cont  i  nue 

0047 

deltax  ■  deltax/2.0 

0048 

deltay  »  deltay/2.0 

0049 

nloop  ■  nloop  ♦  1 

0050 

if  (  nloop  .gt.  5  .or.  niter  .gt.  It 

0052 

go  to  10 

0053 

c 

end 

return 
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ZZB I  real  function  llkeli  (mean,  sigma) 

c 

c  this  function  returns  the  value  of  the 

c  log-likelihood  function  which  Is  to  be 

c  maximized  w.r.t.  the  mean  and  the 

c  standard  deviation 

c 

000 2  real  mean 

c 

ZZB 3  double  precision  ans,  gauss, 

1  x 

c 

0004  common  /  svsto  /  nsta,  ndet(50), 

1  xmag(50),  sdno1s(50) 

c 

000 5  x  •  0.0d0 

0006  do  10  1  *  1 ,  nsta 

0007  If  <  ndet<1>  >  10.  20,  30 

c 

c  detecting  station 

c 

0008  30  continue 

0009  arg  ■  (xmag(l)  -  mean)/sigma 

0010  ans  *  exp  ( -arg*a rg/2 .0 >/s I gma 

001 1  go  to  40 

c 

c  non-detecting  station 

c 

0012  20  continue 

0013  arg  =  <xmag(1)  -  mean  )/sqrt( s 1gma*s Igma  ♦  sdno1s( 1 )*sdno1s( 1 ) ) 

0014  ans  «  gauss  (  arg  ) 

c 

0015  40  continue 

0016  If  <  ans  .It.  1.0d-38  >  ans  -  1.0d-38 

0018  x  *  x  ♦  dlogl0  (ans) 

0019  10  continue 

c 

0020  llkeli  «  x 

0021  return 

c 

0022  end 
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0001  double  precision  function  gauss  <x> 

c 

0002  double  precision  root2,  derfc, 

1  z 

c 

0003  data  root2  /  1 . 4 1 421 3562d0  / 

c 

0004  z  «  -x/root2 

000 5  gauss  *  0.5d0*derfc  (z) 

c 

0006  return 

c 

0007  end 
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0001 

function  derfc  (x) 

000 2 

Implicit  double  precision  (a-h,  o-z ) 

0003 

derfc  -  2 . 0d0 

0004 

If  <  x  .1e.  -10.0d0  >  return 

0006 

derfc  -  0 . 0d0 

0007 

If  <  x  .ge.  20.0d0  >  return 

0009 

derfc  »  1 .0d0 

0010 

If  <  x  .eq.  0.0d0  )  return 

0012 

rootp 1  «  1 .7724538509d0 

0013 

xsqr  •  x  *  x 

0014 

sum  ■  0.0d 0 

0015 

xnum  •  1 . 0d0 

0016 

term  *  1 .0d0 

0017 

If  1  x  .It.  3.1d0  )  go  to  10 

0019 

factor  ■  dexp  ( -xsqr  )/{ rootp1*x > 

0020 

xsqr  *  2.0d0  *  xsqr 

0021 

20 

cont 1 nue 

0022 

suit.  *  sum  ♦  term 

0023 

xnum  ■  xnum  -  2.0d0 

0024 

terml  «  xnum*term/xsqr 

0025 

If  (  terml/term  .It.  -1.0d0  r. 

1 

1  dabs  (terml)  .It.  1.0d-20  >  go  to 

0027 

term  »  terml 

0028 

go  to  20 

0029 

30 

cont 1 nue 

0030 

derfc  *  factor*sum 

0031 

return 

0032 

10 

cont 1 nue 

0033 

factor  ■  dexp  ( -xsqr >*x*2 .0d0/rootp 1 

0034 

xsqr  *  2.0d0*xsqr 

0035 

40 

cont 1 nue 

0036 

sum  «  sum  ♦  term 

0037 

If  (  term/sum  .It.  1.0d-20  )  go  to  50 

0039 

xnum  ■  xnum  ♦  2.0d0 

0040 

term  *  term*xsqr/xnum 

0041 

go  to  40 

0042 

50 

cont 1 nue 

0013 

derfc  *  1 .0d0  -  factor*sum 

0044 

return 

0045 

end 

» 


» 


» 
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this  routlna  parforms  a  network  avarage  for  tha  first 
'ndlsc'  discriminants  for  aach  station  for  a  given  avant 


rea 1*4  stat ,contr ,ms lab , rmtasl 25  > , rlabl 25  > , evbuf < 32 ) , stbuf  (  32 ) 
rea 1 *4  key<4>,  rmx(150>,  d1scr(25),  dtsc<25) 

Integer  setf 1 1 

1 nteger*4  ndsg , nret , levr, Intst.nxst, Istr.msrec.nstat 
equ 1  valence  ( evbuf ( 32  > , 1 ntst ) , <  evbuf ( 31 > , nstat ) ,  ( stbuf ( 19  )  ,nxst ) , 
1  ( stbuf! 1 > , stat ) 

data  contr/ ' ensc 1 / ,  rmx/150*0./ 


common  /flags/  If Igms , 1 f Igev 

common  /asvar/  nxrec 1 , nxrec 2 ■ nxrec 3 , nxrec 4 


call  setfll  ( 1 s Igms. dir '  ) 
define  file  1  < 100, 1 28 . u . nxrec 1 > 

#  of  discriminants  to  average 

ndtsc*21 

write  (6,100) 

100  format  (‘  Input  event  designation  #.  (14)’> 
read  (5,150)  ndsg 
1 50  format  (14) 
key( 1  )*ndsg 

call  search  ( 1 , key , 1 evr , 1 str , 1  con , msrec , ms  1 nd , 1 s reh ) 

If  (Isrch.eq.l)  go  to  999 
read  (1‘levr)  evbuf 
1 f  1  gms*0 
If lgev»l 

convert  1nteger*4  to  1nteger*2 

nsta*nstat* 1 

nd*3 

ndsa v»nd 

nloop*nd1sc/nd+l 

If  ( mod( nd 1  sc . nd ) . eq .0 )  n 1 oop*n 1 oop- 1 

do  15  n* 1 , n 1 oop 

nxst*  1  nt'st 

do  10  k*l  .nstat 

read  (l'nxst)  stbuf 

call  access  ( ndsg , stat . contr ,ms 1 ab , nret , rmeas , r 1 ab , 1 evr ) 
load  matrix  with  measurements 

If  ( n . eq . n 1 oop . and . modi nd 1  sc , nd ) . ne .0 )  nd*mod( nd 1  sc , nd ) 
do  20  J ■ 1 , nd 
1 nd* j ♦( k- 1  )*nd 
1off*J+(n-l  )*ndsav 
rmx( 1nd)  =  rmeas(  loff) 

20  continue 
10  continue 

call  mblas  ( rmx , nsta , nd , d 1  sc r ) 
do  14  1  • 1 , nd 
1  nd*  1  ♦ ! n- 1  )*ndsav 
disc!  1  nd  >*d  1  sc  r (  1  ) 

14  continue 

15  continue 


write  (6.200)  ( r lab( 1 ) , d 1  sc ( 1 ) , 1  *  1 , nd 1  sc ) 
200  format  <20<5(a4.'  :  ’  ,  f 7 . 3 . 5x  )/ )  ) 

999  endflle  1 
stop 
end 
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0001  rea1*4  evlat.evlon, evmb, stat, contr,rmeas( 100), rlab< 100) 

0002  raa1*4  mslab, evbuf ( 32 > , stbuf < 32  ) 

0003  1 nteger*4  nev , 1 ntev , nd*g , 1avorg( 5 > , 1 dpth , 1 ntat , nstat 

0004  IntegerM  nxev , nxst , neon . 1contr( 1 2 >, 1 evr , nrat , Idstat 

0005  equivalence  < evbuf ( 1 > . ndag > ,  < awbuf ( 2  ) , tavorg  ) ,  ( evbuf ( 7  )  .avlat ) 

1  ( evbuf ( 8  )  .avion  ) ,  (evbuf ( 9  )  .evrnb  ) ,  ( evbuf ( 10) , Idpth ) , 

2  ( evbuf ( 30) , nxav  ) ,  ( evbuf ( 31 >, nstat ) ,  < evbuf ( 32  ), 1 ntst ) 

0006  equivalence  < stbuf ( 1 >, stat > ,  ( stbuf ( 2 >, Idstat ) ,  < stbuf ( 1 9 >, nxst ) 

1  < stbuf ( 20) .neon ) ,  ( stbuf ( 21 >, Icontr > 

0007  data  contr/’ensc'/ 

0008  common  /flags/  1 f 1 gms , If  1 gev 

0009  common  /asvar/  nxrec 1 , nxrec2 , nxrec3 , nxrec 4 

c 

0010  call-  setf 1 1  ( 1 , ' s Igms .dl r ' > 

0011  define  file  1  ( 32000 . 1 28 , u , nxrec 1 ) 

c 

0012  read  (1*1)  nev.lntev 

0013  If  (nev.eq.0>  go  to  999 

c 

0015  write  (6,100) 

0016  100  format  ('  Input  0  to  list  event  1nfo<  1  to  Include  stat.  seas.  , 

1  ■  <  11  )'  ) 

0017  read  (5,150)  Iflg 

0018  150  format  (11) 

0019  1  continue 

0020  write  (6.200) 

0021  200  format  ('  Input  first  and  last  event  sequence  #"sJ213>', 

1  1  [<cr>  to  exit)') 

0022  read  (5,250)  tflrst.llast 

0023  250  format  (213) 

0024  If  (Iflrst  .le.  0)  go  to  999 

0026  If  (Iflrst  .gt.  nev )  go  to  999 

0028  If  (llast  .gt.  nev)  11ast*nev*l 

c  loop  over  events 

0030  nxev«1ntev 

0031  do  10  k«l , 1  last 

0032  write  (6,260) 

0033  260  format  (  /// ) 

0034  1evr«nxev 

0035  read  (l'nxev)  evbuf 

0036  If  (k. It. If Irst)  go  to  10 

0038  write  (6,300)  k , ndsg , 1 evorg , ev 1  at ,ev 1  on , evmb , 1 dpth , nstat 

0039  300  format  ('  event  seq  #  *  ' , 1 3 , 5x . ' event  designation  #  -  '.14/ 

1  1  origin  time  :  1  ,  1 2  .  1  3 , 2x  ,  3( 1 2 . 1 x  ) , 4x , ' 1  at  1 tude  ( +n )  : 

2  f8. 3, 5x. ' longitude  ( *e >  :  ',f8.3/'  mb  -  ',f4.2,5x, 

3  'depth  (km)  ■  ',14,5x,'#  of  stations  »  ’,13) 

c  loop  ever  stations 

0040  nxst*1ntst 

0041  do  20  j“l. nstat 

0042  write  (6,320) 

0043  320  format( / ) 

0044  read  (l'nxst)  stbuf 

0045  write  (6.350)  1 dstat , stat ,  (  1 contr  (  1 ♦(  1  -  1  )  *3 > ,  1  *  1  ,  neon  ) 

0043  350  format  ('  station  *  :  ' , 1 2 , 10x . ' stat Ion  name  :  '.a4/ 

1  '  contractors  present  :  ',4(a4.3x>) 

004  7  If  ( 1 f 1 g . eq . 0 >  go  to  20 

0049  1 f 1 ge  1 
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t. 


0050 
0051 
00  =  2 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
0060 
0061 


call  acceaa  ( ndag , stat .eontr .malab.nret , rmeaa , r lab, levr > 
write  (6,400)  eontr 

400  format  ('  meaaurementa  for  contractor  s  ,a4) 
write  (6,450)  ( r 1 ab( 1 > , rmeaa( 1  ) , 1  *  1 . nret ) 

450  format  (20(5(a4.‘  :  1 . f 9 . 3 , 5x  )/ ) ) 

20  continue 
10  continue 
go  to  1 
999  endflle  1 
stop 
end 


L 


l 


t 


I 
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0001  subroutine  search  ( If  1 ag , key .evrec , strec , Icon , msrec , ms  1 nd , 1 srch ) 

c  this  routine  searches  for  a  specific  keyword  and  returns  the 

c  appropriate  record  and/or  Index 

c 

c  1flag«0  full  search  (needs  all  keys) 

c  1flag«l  search  for  event 

c  1flag“2  search  for  station  (needs  evrec) 

c  1flag*3  search  for  contractor  (needs  strec) 

c  1flag“4  search  for  measurement  (needs  Icon) 

c  (returns  rec  #  In  's1gmxxxx.dat'  and  Index  Into  rec ) 

c  key( 1  )«event  designation 

c  key( 2 >»stat1on  name 

c  key ( 3  )“contractor  name 

c  key(4 >»measurement  mnemonic 

c  1srch«0  successful  search 

c  1srch*l  unsuccessful  search 

c 

0002  1nteger*4  nev , 1 ntev , ndr , mndr , evrec , strec , msrec , nmeas 

0003  1nteger*4  ndsg , nxev , nstat , 1 ntst , nxst , nxms , 1 contr ( 1 2 ) 

0004  real*4  key ( 4  ) , buf f ( 32 ) .msbuf f ( 64 > 

0005  equivalence  ( buf f ( 1  ), ndsg , stat ) ,  ( buf f ( 1 9  ) , nxst ) ,  ( buff ( 30 ), nxev ) 

0006  equivalence  ( buff ( 31  ), nstat  ) ,  ( buf f ( 32  ) , 1 ntst ) ,  ( msbuf f ( 64 ), nxms ) , 

1  ( buff ( 21  ) , icontr > 

0007  common  /asvar/  nx rec 1 , nxrec 2 , nxrec 3 , nxrec 4 

0008  1srch*0 

0009  If  (lflag.eq.0)  go  to  100 

0911  goto  (100,200,300,400).  Iflag  _ 

0012  100  read  (11)  nev , 1 ntev , ndr . mndr 

0013  If  (nev.eq.9)  go  to  995 

c  search  thrc  gh  events 

0015  nxev«1ntev 

0016  do  10  k* 1 , nev 

0017  evrec*nxev 

0018  read  ( 1 'nxev)  buff 

0019  If  ( key ( 1  )  ,eq . f loat( ndsg  ) )  go  to  15 

0021  1.0  continue 

0022  write  (6,14)  key( 1  ) 

0023  14  format( '  event:  ,,f4.0,'  not  found') 

0024  1srch»l 

0025  go  to  999 

0026  15  continue 

0027  If  (1f1ag.eq.0)  go  to  201 

0029  return 

0030  200  continue 

c  search  through  stations  given  base  vector  (event)  record  # 

0031  If  (evrec. eq.0>  go  to  995 

0033  read  (1' evrec)  buff 

0034  201  If  (nstat. eq.0)  go  to  995 

0036  kount«nstat 

0037  nxst«1ntst 

0938  do  20  k»l,kount 

0.039  strec*nxst 

0040  read  (l'nxst)  buff 

0041  If  ( key( 2  )  .eq . stat )  go  to  25 

0043  20  continue 

0044  write  (6,24)  key(2> 

0.345  24  format( '  station:  ',a4,'  not  found') 
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0046 
004  7 
004  8 
0049 
0051 
0052 

0053 
0055 
0056 
0057 
005  8 
0060 
0061 
0062 
0063 
006  4 
0065 
0066 
006  8 
0069 
0070 
0071 
0072 
007  3 
007  5 
0076 
0078 
0079 

0080 

0031 

0082 
008  3 
008  5 
0085 
0087 
0088 
008  9 
0090 
0091 
0092 
0093 
0094 
009  5 
0096 
009  7 
0098 


1srch«l 
go  to  999 
25  continue 

if  (lflag.eg.0)  go  to  301 
return 

300  continue 

c  search  station  record  for  contractor  index 

if  <strec.eq.0)  go  to  995 
read  (l'strec)  buff 

301  continue 

do  30  1con«21,30,3 

If  ( key( 3 ) .eq.buff ( Icon > )  go  to  35 
30  continue 

wrtte  (6,34>  key(3> 

34  format!'  contractor:  ',a4,'  not  found1) 
tsrch«l 

go  to  999 

35  continue 

If  (1flag.eq.0)  go  to  400 
return 

400  cont 1 nue 

lof f *  Icon-20 
msrec* Icontr! loff+1  ) 
nmeas«1contr( toff +  2  > 

If  (nmeas.eq.0)  go  to  995 
nbl k«nmeas/3 1 ♦ 1 

If  < nod ( nmeas , 3 1  ) . eq .0 )  nblk“nblk-l 

nxms»msrec 

do  45  n»  1  , nb 1 k 

c  set  msrec  to  current  rec  # 

msrec*nxms 

read  (2'nxms)  msbuff 

e  search  through  measurement  mnemonics 
do  40  k-32.62 

If  ( key ( 4  ). eq . msbuff ( k ) )  go  to  50 
40  continue 

45  continue 

write  (6.46)  key! 4 ) 

46  format! '  measurement:  ',84,'  not  found') 

1  srch* 1 

go  to  999 
50  continue 
ms  1  nd*k-31 
go  to  999 

995  write  (6.996) 

996  format! '  error  on  search' > 
stop 

999  return 
end 
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0001 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

0002 

0003 

0004 

0005 

0006 

0007 


0008 
0009 
0010 
001  1 


00 12 
0013 
0014 
0015 
0016 
0017 
0018 

c 

0019 

0020 

0021 

0022 

0024 

0025 

C 

002  3 
0029 
0020 

c 

0022 

*223 

eC25 


subroutine  access  ( ndsg , stat .eontr , ms  1 ab, nret , rmeas , r lab , levr ) 
this  routine  accesses  the  signal  measurement  data  base 

ndsg*event  designation  *  ,  ,  , , 

stat-statlon  name  (If  »  '•***', given  measurement  Is  returned  for  all 
stations  for  event) 
contr»contract.or  name 

1 f 1 gms *0  return  all  measurements  for  station  (In  rmeas)  with  assoc. 

labels  (In  rlab) - warning:  It  should  be  noted  that 

there  Is  no  guarantee  all  the  meas.  will  be  In  the  same 
order  across  stations 

1flgms*l  return  only  Indicated  measurement 
ms  1  ab* 1 abe 1  of  desired  measurement 
nret*#  of  measurements  returned 
rmeas*measurement  values 
r 1 ab*assoc 1 ated  measurement  labels 
1flgev*0  search  for  event 

Iflgev*!  use  previous  or  supplied  event  record  #  (levr) 

1evr*event  record  # 

rea 1*4  stat , eontr , ms  1 ab , rmeas ( 1 >.rlab( 1 ),evbuf<32>. stbuf  (  32  > 
real*4  buf f ( 64 ) , key ( 4 ) , rnaml  (  4 ) 

Integer *4  ndsg,  levr,  1  str.msrec.nxms, ns tat , 1 ntst , nxst , 1 eontr ( 12) 

1ntecer*4  nret 

loglcal*l  tempi  ( 4  >  , 

equivalence  (evbuf  (  31 ) .nstat ) .  (  evbuf  (  32 ) , Intst ),  ( stbuf ( 19  > .nxst) . 

1  ( buff < 64 > ,nxms > .  ( stbuf ( 2 1 >, 1 eontr  ) 

equivalence  (  rnaml  (  2  )  .tempi  ) 

data  rnaml /' s Igm '  , ' . dat ' .0 . / ,  star/'****'/ 

common  /flags/  1 f 1 gms , i f 1 gev 

common  /asvar/  nxrec 1 , nxrec 2 , nx rec 3  ,  nxrec 4 

construct  data  file  name  and  open  file  (directory  file  should  already  be 
open  ) 

encode  (4,1, tempi)  ndsg 

1  format  (14) 

decode  (4, 2. tempi)  tempi 
encode  (4, 2, tempi)  tempi 

2  format  (411) 

call  setfll  (2, rnaml) 

define  file  2  ( 100 . 256 , u , nxrec2 ) 

nret*0 
key < 1 >»ndso 
key ( 3  )*centr 

If  (  iflgev. eq.0)  call  search  ( 1 , key , levr . 1 str , Icon , msrec . ms  1 nd , 

1  Isreh) 

If  ( If lgev.eq.0. and. Isreh. eq . 1 )  go  to  995 
If  ( stat  .eq  .  star  )  go  to  500 
search  for  specified  station 
key ( 2  )*stat 

call  search(2,key, levr, istr, Icon .msrec .mslnd, Isreh) 

If  (Isreh. eq . 1 >  go  to  995 
sea-eh  for  contractor  Index 

call  search  ( 3 . key . levr , 1 st r , 1  con . ms rec , ms  1 nd . 1 srch > 
if  (Isreh. eq.l)  go  to  995 
If  (  If Igrs.eq. 1  )  go  to  30 
ret-rn  all  measurements  for  station 
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0037 
0038 
0039 
0040 
0041 
004  2 
0044 
004S 
0046 
004  7 
0048 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
005  7 
0058 
005  9 
0060 
0062 
006  3 
006  4 
0065 
0066 

0067 

0068 

0069 

0070 

0071 

0072 

007  3 
0074 

0076 

0077 

0079 

0080 

0081 

008  2 

083 

0084 

0085 


read  ( 1 1 Istr >  stbuf 
loff “Icon-20 
msrec» Icontrl 1off*l  ) 
nret“1contr( ioff+2) 
nbl k«nret/31+l 

If  ( mod< nret . 31 > . eq .0)  nblk«nb1k-l 

nxns*nsrec 

do  10  n=l ,nblk 

read  (2'nxms)  buff 

1 1 m»nret-<  n- 1 >*31 

If  <11m.gt.31>  11m-31 

do  20  k-1 , 1  1m 

tst-<  n-1  )«31+k 

rme,as(  1st)*buff(k> 

rlab( 1st)«buff(k+31 > 

20  continue 
10  continue 
go  to  995 
3.7  continue 

key  <  4  >*ms lab 

call  search  < 4 , key . 1 evr , 1 str , Icon , msrec , ms  1 nd , 1 sreh > 
If  (tsrch.eq.l)  go  to  995 
read  (2 ’msrec)  buff 
nret” 1 

rmeasf  nret  >«buff ( ms  1 nd  ) 
go  to  995 
500  continue 

c  return  one  measurement  for  all  stations  across  event 

key ( 4  )*ms lab 
read  (1’levr)  evbuf 
nxst”  1  ntst 
do  40  k« 1 , nstat 
1  str»nxst 

read  (l’nxst)  stbuf 
c  search  for  contractor  index 

call  search  < 3 , key . 1 evr , 1 str , 1  con . msrec , ms  1 nd , i srch ) 
If  (Isrch.eq.l)  go  to  40 
c  search  for  measurement 

call  search  < 4 , key , 1 evr , 1 str , 1  con , msrec , ms  1 nd , 1 srch > 
If  <1srch.eq.l>  go  to  40 
read  <2’msrec)  buff 
nret'nret* 1 

rmeasf  nret  ) ”buf f ( ms  1 nd  > 

40  continue 
995  endf 1 le  2 
return 
end 
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real *4  stat,contr,mslab,rmaas( 100) ,rlab( 100) 

1nteger*4  ndsg , nret , 1 evr 

data  star/ '*“**'/ ,ensc/ ’ ensc ' / 

data  gumo/ ' gumo ' / 

common  /flags/  If Igms , If Igev 

common  /asvar/  nxrec 1 , nxrec 2 , nxrec 3 , nx rec 4 

call  setf 1 1  ( 1 , ' s 1 gms .dir' ) 

define  file  1  ( 32000, 1 28 . u , nxrec 1) 

1  f 1 gms“ 1 
wr I te( 6 , 100 ) 

format! '  Input  event  designation  »  (14)') 
read!5.150)  ndsg 
format! 1 4 ) 
wr  l.te!  6 , 200 ) 

format!'  Input  station  name  !a4)') 
read<5,250)  stat 
format! a4 ) 

If  < stat . ne . star .and . If lgms . eq .0 )  go  to  50 
write! 6. 300) 

format!'  Input  measurement  label  !a4)') 

read! 5 , 250  )  ms  1 ab 

cont 1 nue 

contr*ensc 

If  1  gev»0 

call  access  ( ndsg . stat , cont r , ms  1 ab , nret , rmeas , r lab , levr ) 
write  !6,10)  nret, levr 
format! 5x , 2 1 6  > 

write  !6.15)  ( rmeas! k ), k* 1 . nret ) 

format  ( lx, 10f 10. 1 > 

write  16.16)  < r 1 ab! k  ) , k» 1 , nret ) 

format  <  lx , 10! a4 , 2x ) ) 

stop 

end 


EXSCO,  INC 


B  -  34 


RETURN 

(PAGE  2  OF  5) 


UNIX  fortran  1v  V01-11  source  listing  page  001 

0001  subroutine  search  (  If  1  ag , key  .evrec  , strec  ,  Icon .msrec  ,ms  1  nd ,  I srch  > 

c  this  routine  searches  for  a  specific  keyword  and  returns  the 

c  appropriate  record  and/or  Index 

c 

c  1f1ag*0  full  search  (needs  all  keys) 

c  1flag*l  search  for  event 

c  1flag*2  search  for  station  (needs  evrec) 

c  1flag*3  search  for  contractor  (needs  strec) 

c  1flag*4  search  for  measurement  (needs  Icon) 

c  (returns  rec  #  In  's1gmxxxx.dat'  and  Index  Into  rec ) 

e  key(l)*event  designation 

c  key< 2 >*stat1on  name 

c  key( 3 >*contractor  name 

c  key(4)  measurement  mnemonic 

c  1 srch=0  successful  search 

c  1srch»l  unsuccessful  search 

c 

0002  1nteger*4  nev , 1 ntev , ndr , mndr , evrec , strec , msrec , nmeas 

0003  IntegerM  ndsg , nxev , nstat , 1 ntst , nxst , nxms , 1 eontr ( 1 2 ) 

0004  rea1*4  key( 4  ) , buf f ( 32 > .msbuff ( 64 ) 

0005  equivalence  ( buf f( 1 >, ndsg , stat ) .  ( buf f ( 1 9 > , nxst > .  ( buf f ( 30 ) . nxev ) 

0006  equivalence  ( buf f ( 3 1  ) , nstat > .  ( buf f ( 32 > , 1 ntst ) .  ( msbuff ( 64 >, nxms ) , 

1  ( buff ( 21 ) . Icontr > 

0007  common  /asvar/  nxrec 1 , nxrec2 , nxrec 3 , nx rec 4 

0008  1srch»0 

0009  If  (lflag.eq.0)  go  to  100 

0011  go  to  (100.200,300.400),  If  lag 

0012  100  read  (l'l)  nev , 1 ntev . ndr , mndr 

0013  If  (nev.eq.0)  gv  to  995 

c  search  through  events 

0015  nxev«1ntev 

0016  do  10  k» 1 , nev 

0017  evrec»nxev 

0018  read  (l'nxev)  buff 

0019  If  ( key! 1 > .eq .float! ndsg > )  go  to  15 

0021  10  continue 

0022  write  (6.14)  key! 1 ) 

0023  14  format! '  event:  ',f4.0,'  not  found') 

0024  1srch»l 

0025  go  to  999 

0026  Is  continue 

0027  If  (lflag.eq.0)  go  to  201 

0029  return 

0030  20C  continue 

e  search  through  stations  given  base  vector  (event)  record  # 

0031  If  (evrec. eq.0)  go  to  995 

0033  read  (I'evrec)  buff 

0034  201  If  (nstat. eq.0)  go  to  995 

0036  kount*nstat 

0037  nxst»intst 

0038  do  20  k*l,kount 

0039  strec»nxst 

0040  read  (l'r.xst)  buff 

0041  If  ( key ( 2 ) .eq . stat )  go  to  25 

0043  20  continue 

0044  write  (6.24)  key(2) 

0045  24  fo'matf'  station:  ’,a4.'  not  found') 
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0046 

0047 

0048 

0049 

0051 

0052 

0053 

0055 

0056 

0057 

0058 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0068 

0069 

0370 

0071 

0072 

0073 

0075 

e076 

0078 

0079 

0060 

0081 

0082 

0033 

0035 

0086 

0087 

0069 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 


1srch*l 
go  to  999 
25  continue 

If  (1flag.eq.0)  go  to  301 
return 

3 00  continue 

e  search  station  record  for  contractor  Index 

If  <  strec . eq . 0 )  go  to  995 
read  (1* strec)  buff 

301  continue 

do  30  1con*21,30,3 
If  ( key < 3  )  .eq . buf f < Icon > >  go  to  35 
30  continue 

write  (6,34)  key(3> 

34  format! '  contractor:  '  ,a4,’  not  found’) 

1 srch» 1 

go  to  999 

35  continue 

If  (<flag.eq.0>  go  to  400 
return 

400  continue 

1  off* Icon-20 
nsrec* tcontr! 1off+l ) 
nmeas* Icontr! loff+2) 

If  (nmeas. eq.0)  go  to  995 
nbl k*nmeas/3 1 ♦ 1 

If  ( mod! nmeas , 3 1 > .eq .0 >  nb1k*nblk-l 

nxms*ir.srec 

do  45  n* 1 , nbl k 

e  set  mrrec  to  current  rec  # 

msrec*nxms 

read  ( 2  '  nxms  >  msbuf f 

e  search  through  measurement  mnemonics 
do  40  k * 3 2 , 6 2 

If  ( key ( 4  ) . eq . msbuf f ( k ) )  go  to  50 
40  continue 

45  continue 

write  (6.46)  key(4) 

46  format!'  measurement:  ’,a4t’  not  found’) 
1srch*l 

go  to  999 
50  continue 
ms  1 nd=k -3 1 
go  to  999 

995  write  (6,996) 

996  f  orr  at!  '  error  on  search') 
stop 

999  return 
end 
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0101  subroutine  access  ( ndsg , stat .contr ,mslab, nret , rmeas , r lab, levr ) 

e  this  routine  accesses  the  signal  measurement  data  base 

c  ndsg*event  designation  # 

c  stat*stat1on  name  (  If  ■  '••**', given  measurement  Is  returned  for  all 

c  stations  for  event) 

c  contr«eontractor  name 

c  1flgms“0  return  all  measurements  for  station  (In  rmeas)  with  assoc. 

c  labels  (In  rlab) - warning:  It  should  be  noted  that 

c  there  Is  no  guarantee  all  the  meas.  will  be  In  the  same 

c  order  across  stations 

c  1flgms«l  return  only  Indicated  measurement 

c  ms1ab*1abel  of  desired  measurement 

c  nret*#  of  measurements  returned 

c  rmeasameasurement  values 

c  rlab*assoc lated  measurement  labels 

c  1flgev»0  search  for  event 

c  1flgev»l  use  previous  or  supplied  event  record  #  (levr) 

c  ievr*event  record  # 

c 

0002  rea 1 *4  stat, contr. mslab, rmeas ( 1  ),rlab( 1  ),evbuf(32),stbuf(32) 

0003  real*4  buff < 64 > , key( 4 ) , rnaml ( 4 ) 

0004  1 nteger*4  ndsg, levr, 1 str , msrec , nxms , ns tat , Intst.nxst, 1 contr ( 1 2 ) 

0005  1nteger*4  nret 

0006  loglcalM  templ(4> 

0007  equivalence  ( evbuf ( 3 1  ) , nstat ) , ( evbuf ( 32  ) , 1 ntst ) ,  ( stbuf ( 1 9 > , nxst ) , 

I  ( buf f ( 64  ) , nxms > ,  ( stbuf ( 21  ), Icontr > 

0006  equivalence  (  rr.aml  (  2  )  .tempi  ) 

0009  data  rnaml /' s Igm '  ' , 1 .dat ' ,0. t ,  star/1****'/ 

0010  common  /flags/  1  f  Igms , 1 f lgev 

0011  common  /asvar/  nxrec 1 , nx rec2 , nxrec3 , nx rec4 

c 

c  construct  data  file  name  and  open  file  (directory  file  should  already  be 

c  open ) 

0012  encode  (4,1, tempi)  ndsg 

0013  1  format  ('14  ) 

0014  decode  (4, 2, tempi)  tempi 

001S  encode  (4, 2, tempi)  tempi 

0016  2  format  (411) 

0017  call  setfll  (2, rnaml) 

0018  define  file  2  ( 100. 256 , u , nxrec2 ) 

c 

0019  nret*0 

0020  key( 1  )»ndsg 

0021  key(3)»contr 

0022  If  ( If lgev.eq.0)  call  search  ( 1 , key , levr , 1 str , Icon , msrec ,ms 1 nd , 

1  1 srch  ) 

0024  If  ( If lgev .eq .0.and . 1 srch . eq . 1 )  go  to  99a 

0026  If  ( stat . eq . sta r )  go  to  500 

c  search  for  specified  station 

0028  key(2)*stat 

0029  call  search( 2 , key , levr , 1 str , Icon , msrec , ms  1 nd , 1 srch ) 

0030  If  (tsrch.eq.l)  go  to  995 

c  search  for  contractor  Index 

0032  call  search  ( 3 , key . 1 evr , 1 str , 1  con , msrec , ms  1 nd . 1 srch ) 

0033  If  ( larch. eq.l)  go  to  995 

0035  If  ( If  1 gms . eq . 1 )  go  to  30 

c  return  all  measurements  for  station 
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22 37 
0038 
0039 
0040 
0041 
0042 
004  4 
0045 
0046 
004  7 
0048 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
005  7 
0058 
005  9 
0060 
0362 
096  3 
006  4 
0065 
006  6 

0367 

0358 

0063 

0070 

0071 

0072 

0073 

0074 

0076 
037  7 
0079 
0083 
0081 
0382 
0083 
034 
0385 


read  ( 1 ' Istr  )  stbuf 
iof f » Icon-20 
msrec»1eontr( 1off+l  ) 
nret»1contr( 1off*2> 
nbl k»nret/3 1 +1 

If  ( modi nret , 31 ) .eq .0)  nblk»nb1k-l 

nxns'msrtc 

do  10  n»l,nb1k 

read  (2'nxms)  buff 

1 1m«nret-( n- 1  1*31 

If  ( 1 1m. at. 31 )  1 1m-31 

do  20  k« 1  ,  1  1m 

1 st«( n- 1  )*31  +  k 

rmeasl 1st)»buff(k> 

rlab( 1st)»buff ( k ♦ 3 1  ) 

20  continue 
10  continue 
go  to  995 
30  continue 

key( 4  >»mslab 

call  search  ( 4 , key , 1 evr , 1 str , 1  con ,msrec ,ms 1 nd . 1 srch ) 
If  (Isrch.eq.l)  go  to  995 
read  <2'msrec)  buff 
nret* 1 

rmeasl nret)»buff(ms1nd) 
go  to  995 
500  continue 

c  return  one  measurement  for  all  stations  across  event 

key( 4  >Mms lab 
read  < 1 ' ievr  )  evbuf 
nxst* 1 ntst 
do  40  k» 1 , nstat 
1 str»nxst 

read  (l'nxst)  stbuf 
c  search  for  contractor  Index 

call  search  ( 3 . key . Ievr , 1 str , 1  con , msrec ,ms 1 nd , 1 srch ) 
If  (Isrch.eq.l)  go  to  40 
c  search  for  measurement 

call  search  ( 4 , key . Ievr . 1 str . Icon , msrec . ms  1 nd , 1 srch ) 
If  (Isrch.eq.l)  go  to  40 
read  (2 'msrec)  buff 
nret«nret*l 

rneas(nret)*buff(ms1nd) 

40  continue 
995  endflle  2 
return 
end 
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The  Raw  Signal  Measurement  Tape  is  one  of  the  tapes  gen¬ 
erated  by  the  automated  Signal  Extraction  Process  of  the 
Event  Identification  System  (EIS)  on  the  IBM  360/44  computer. 
This  tape  is  a  1600  bpi  nine-track  tape  and  is  written  in  the 
standard  ENSCO  format  using  physical  I/O. 

The  standard  nine-track  tape  format  consists  of  a  label 
file  followed  by  one  or  more  data  files,  followed  by  a  trailer 
file.  Each  record  in  the  data  files  represents  a  physical 
transfer  of  a  specified  number  of  bytes  from  program  memory 
to  magnetic  tape.  This  results  in  efficient  tape  I/O  and  in 
a  compact  and  easily  interpreted  tape.  Figure  C-l  illustrates 
the  organization  of  the  Raw  Signal  Measurement  Tape.  The  in¬ 
dividual  components  are  described  below. 

The  label  file  consists  of  two  80-byte  records  followed 
by  an  end-of-file  mark  (EOF).  The  first  record  is  the  IBM 
volume  -  serial  header  and  begins  with  the  characters  VOL1 . 

The  second  record  is  the  ENSCO  header  and  begins  with  the 
characters  HDR1 .  The  label  file  should  be  recognized  by  the 
IBM  360/44  as  a  standard  tape  label. 

The  data  files  each  consist  of  a  1500-byte  event  header 
record  followed  by  a  400-byte  data  record  containing  the  raw 
signal  measurements,  followed  by  an  end-of-file  mark.  A 
separate  data  file  is  generated  for  each  event -station  pro¬ 
cessed,  and  the  data  files  are  organized  by  site  number  (event 
header  word  91).  The  stations  corresponding  to  a  given  site 
number  are  presented  in  Table  C-l  along  with  their  locations 
and  tectonic  class. 
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TABLE  C-l 

SITE  NUMBER  ASSIGNMENTS 


Site  No. 

• 

Station 

Latitude 

Longitude 

Tectonic  Class 

1 

ANMO 

34.95 

-106.46 

R 

2 

ANTO 

39.87 

32.79 

A 

3 

BOCO 

4.59 

-74.04 

A 

4 

CHTO 

18.79 

98.98 

A 

5 

NORS 

60.84 

10.89 

I 

6 

GUMO 

13.59 

144.87 

A 

7 

MAIO 

36.30 

59.49 

A 

a 

LAS  A 

46.69 

-106.22 

I 

9 

NWAO 

-32.93 

117.24 

I 

10 

GRFO 

49.69 

11.22 

I 

n 

SHIO 

25.57 

91.88 

A 

12 

TATO 

24.98 

121.49 

A 

13 

SNZO 

-41. 31 

174 . 70 

A 

14 

ILPA 

35 . 70 

50.61 

A 

15 

ALPA 

65.00 

-147.  20 

A 

16 

CTAO  (ASRCH 

-20.09 

146.25 

I 

17 

ZOBO 

-16.27 

-68.13 

A 

18 

KAAO 

34.54 

69.04 

A 

19 

MAJO 

36.54 

138.21 

A 

20 

KONO 

59.65 

9.60 

I 

21 

BFAK 

64.77 

-146.89 

A 

22 

CTAO(HGLP) 

-20.09 

146.25 

I 

23 

CHGO 

18.79 

98.98 

A 

24 

TNAK 

62.91 

-156.02 

A 

25 

TLOO 

39.86 

-4.01 

I 

26 

El  AO 

29.55 

54.95 

R 

27 

KONO 

59.65 

9.60 

I 

28 

OGDO 

41.07 

-74.62 

I 

29 

KIPO 

21.42 

-158.02 

A 

30 

ALQO 

34.94 

-106.46 

R 

31 

ZLPO 

-16.27 

-68.13 

A 

32 

MATO 

36.54 

138.21 

A 

33 

HNME 

46.16 

-67.99 

I 

34 

RKON 

50.84 

-93.67 

I 

35 

KSRS 

37.45 

127.92 

1 

36 

ATAK 

52  .  88 

173.17 

A 

37 

UCAK 

66.00 

-153.72 

A 

58 

CNAK 

67.45 

-144.52 

A 

39 

NJAK 

65.06 

-141.83 

A 

40-50 

Unassigned 

- 
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Table  C-2  describes  all  possible  event  header  entries. 

In  this  application,  not  all  the  entries  in  the  header  record 
are  used.  Entries  in  the  header  corresponding  to  seismic 
information  for  specific  phases  should  be  disregarded.  In¬ 
formation  pertaining  to  an  event  or  a  station,  or  to  non- 
seismic  data  (i.e.,  data  record  length,  etc.)  is  still  mean¬ 
ingful  . 

Table  C-3  defines  the  raw  signal  measurements  present 
in  the  data  record.  The  amplitude  measurements  (words  1-21) 
are  corrected  for  distance  using  appropriate  B-factors  (Sax 
et  al . ,  1978).  In  addition,  the  data  entries  have  either 
+1000  or  -1000  added  to  them  to  indicate  whether  tne  value 
is  a  signal  measurement  or  a  noise  measurement,  respectively. 
A  zero  entry  indicates  that  no  measurement  is  available  for 
the  corresponding  quantity.  No  regional  S  or  Lg  data  were 
I  processed  for  this  data  base. 

Finally,  the  data  files  are  followed  by  a  trailer  file 
containing  one  80-byte  record  beginning  with  the  characters 
I  EOIO.  This  record  is  followed  by  at  least  two  consecutive 

end-of-file  marks. 
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TABLE  C-2 


STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  1  OF  7) 


Words 

Data 

Type* 

Field 

. 

1 

I 

Seismogram  number. 

2 

I 

Number  of  components  (1  or  3) . 

3 

I 

Edit  length  (time  points). 

4 

F 

Number  of  samples  per  second. 

5 

■  F 

Edit  start  time  (hours) . 

6 

F 

Edit  start  time  (minutes). 

n 

F 

Edit  start  time  (seconds) . 

8-9 

A 

Array  name. 

10-12 

A 

Event  designation. 

13-14 

A 

Data  type  ('EDIT',  ’GEN’,  or  'DISCR'). 

1 5 

I 

Data  record  length  (bytes) . 

16 

I 

Number  of  edited  sites. 

17-18 

A 

Data  partition  ('SIGNAL'  or  ’NOISE’) 

19 

A 

Domain  ('TIME'  or  ’FREQ’) . 

20-21 

A 

Source  routine. 

7  ? 

A 

Data  orientation  code  ('RAW'  or  'PBD') 

25 

I 

Maximum  number  of  channels  processed. 

24 

I 

Number  of  channels  deleted. 

25 

F 

Re-sample  rate. 

26 

I 

Edit  start  time  (seconds  into  day). 

27 

I 

Edit  start  time  (year-day). 

*A  =  Alphanumeric,  I  =  Integer,  F  =  Floating  Point 
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TABLE  C-2 


STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  2  OF  7) 


Words 

Data 

Type* 

Field 

28 

F 

Edit  length  (seconds) . 

29-33 

B 

Site  status  table  (0=present,  l=absent) . 

34 

I 

Number  of  uncorrectable  'data  spikes 
encountered  during  edit. 

35 

I 

Number  of  data  clips  encountered  during 

edit . 

36 

I 

Filter  application  code. 

37 

I 

Smoothing  code. 

38 

I 

CH  equalization  code. 

39 

I 

Calibration  Code. 

40 

I 

QC  procedure  code. 

41 

I 

Taper  code. 

42 

F 

Initial  beam  or  bandpass  frequency. 

43 

F  • 

Final  beam  or  bandpass  frequency. 

44 

F 

Frequency  increment. 

45 

I 

Number  of  frequencies. 

46 

I 

Length  of  transform  (time  points) . 

47 

I 

Length  of  data  transformed,  or  integration 
gate  (time  points). 

48 

I 

Number  of  transforms  stacked. 

49 

I 

Number  of  edited  transforms  deleted  from 

stacking . 

50 

F 

Noise  taper  coefficient. 

*A  =  Alphanumeric,  I  =  Integer,  F  =  Floating  Point 
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TABLE  C  -  2 


STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  3  OF  7) 


Words 

Data 

Type* 

Field 

51 

I 

Index  of  signal  start,  relative  to  edit 

start . 

52 

I 

Source  time  (seconds  into  day). 

53 

I 

Source  time  (year-dav) . 

54 

A 

Confidence  of  source  time  (PDE  code). 

5  5 

F 

Source  latitude  (i  90°  N) . 

5  6 

F 

Source  longitude  (0-360°  E) . 

57 

F 

Source  depth  (km) . 

58-59 

A 

Information  source. 

60 

F 

V 

61 

F 

M.. . 

62 

F 

TI  estimated  M  . 

65 

A 

Standard  deviation  of  residual  time. 

64 

A 

Number  of  stations  in  PDE  reporting. 

6  5-69 

A 

Seismic  region. 

70 

A 

NORSAR  quality. 

71 

A 

Sub  -  region . 

7  7 

I 

P  wave  arrival  time  (seconds  into  day). 

7  3 

I 

P  wave  arrival  time  (year-day). 

-  * 
i  -t 

I 

S  wave  arrival  time  (seconds  into  day) . 

7  5 

I 

S  wave  arrival  time  (year-day). 

76 

I 

LQ  wave  arrival  time  (seconds  into  day). 

7  7 

I 

LQ  wave  arrival  time  (year-day). 

A  =  Alphanumeric ,  I  =  Integer,  F  =  Floating  Point 
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TABLE  C-2 

STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  4  OF  7) 


Words 

Data 

Type* 

Field 

78 

I 

LR  wave  arrival  time  (seconds  into  day)  . 

79 

I 

LR  wave  arrival  time  (year-day). 

80 

I 

Estimated  LR  length  (seconds). 

81 

F 

Azimuth  (Great  Circle  beam  direction) . 

82 

F 

Elevation  (Great  Circle  beam  direction). 

85 

F 

Azimuth  (Primary  beam  direction)  . 

84 

F 

Elevation  (Primary  beam  direction). 

85 

F 

Source  to  Array  Great  Circle  distance 
(degrees)  . 

S  6 

F 

Source  to  Array  Great  Circle  distance 
(km)  . 

8  7-88 

A 

Seismometer  type. 

89 

A 

Recording  type. 

90 

F 

Estimated  signal - to-noise  ratio  (dB) . 

91 

I 

Site  Number. 

92 

F 

Site  latitude  (±  90°  N) . 

95 

F 

Site  longitude  (0-  560°  E)  . 

94 

I 

Number  of  sub-arrays. 

95-154 

I 

Index  of  the  first  sensor  in  each  sub¬ 
array  . 

155-174 

F 

Reference  sensor  latitude  (±90°X)  for  each 

sub  -  array . 

1 "5  -  214 

F 

Reference  sensor  longitude  (0-560°E)  for 
each  sub-array. 

215 

A 

Tectonic  class  code. 

*A  =  Alphanumeric,  I  =  Integer,  F  =  Floating  Point 
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STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  S  OF  7) 


Words 

Data 

Type* 

Field 

Long-Period 

Short -Period 

216 

F 

Log. n  of  50  second  am¬ 
plitude  (vertical 
component) . 

S  wave,  LG  (surface) 
wave,  or  regional  P 
wave  magnitude. 

217 

F 

Log^Q  of  33  second  am¬ 
plitude  (vertical  com¬ 
ponent)  . 

Teleseismic  P  wave 
magnitude. 

218 

219 

F 

F 

Log,^  of  23  second 
amplitude  (vertical 

C(  raponent) . 

Log,  L1  of  20  second 
amplitude  (vertical 
component) . 

Measured  phase  arrival 
time  (seconds  into  edit) 
Value  of  999999  indicates 
no  detection. 

Magnitude,  from  first 
envelope  peak. 

220 

F 

LogpQ  of  17  second 
amplitude  (vertical 
component) . 

Mean  smoothed  frequency. 

221 

F 

LogpQ  of  14  second 
amplitude  (vertical 

Maximum  mean  smoothed 
frequency . 

component ) . 

n  ->9 

F 

Logpo  of  12  second 
amplitude  (vertical 
component) . 

Mean  phase  standard 
deviation. 

225 

F 

Log. q  of  50  second 
amplitude  (transverse 
component) . 

Log^p  of  center  frequency 
no.  1 . 

224 

F 

Log. Q  of  53  second 
amplitude  (transverse 
component) . 

Log.r,  of  center  fre- 

°10  o 

quency  no.  _. 

* A  =  Alphanumeric, 

I  =  Integer, 

F  =  Floating  Point 

EN’SCC ,  INC. 

C-10 

TABLE  C-2 


STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  6  OF  7) 


9 

Words 

Data 

Type* 

Field 

0 

225 

F 

Long -Period 

Log1Q  of  25  second  am¬ 
plitude  (transverse 
component) . 

Short-Period 

Log,Q  of  center  frequency 
no.3. 

226 

F 

Log,0  of  20  second  am¬ 
plitude  (transverse 
component) . 

Login  of  center  frequency 
no.  u4. 

0 

227 

F 

Log,0  of  17  second  am¬ 
plitude  (transverse 
component) . 

Log10  of  center  frequency 
no. au5. 

0 

228 

F 

LogiQ  of  14  second  am¬ 
plitude  (transverse 
component) . 

LoglO  of  center  frequency 
no.  6. 

229 

F 

Logio  of  12  second  am¬ 
plitude  (transverse 
component) . 

Log. q  of  center  frequency 
no.  7. 

0 

230 

F 

Logic  of  broadband  A/T. 

Login  of  center  frequency 
no.1  8. 

231-238 

239 

F 

F 

Undefined. 

Undefined. 

Log10  of  displacement  at 
center  frequencies  no. 1-8. 
Broadband  complexity. 

c 

240 

F 

Undefined. 

Envelope  complexity. 

241-248 

F 

Undefined. 

Instantaneous  frequency 
complexity  at  center 
frequencies  no.  1-8. 

w 

249 

F 

Undefined. 

m  (taken  from  first 

Pfive  seconds  of  data. 

*A  ■  Alphanumeric,  I  *  Integer,  F  *  Floating  Point 

S 


Fxsrn.  INC.  •  r-11 


TABLE  C-2 


STANDARD  EVENT  HEADER  DESCRIPTION 
(PAGE  7  OF  7) 


Words 

Data 

Type* 

Field 

Long -Period 

Short -Period 

250 

F 

Undefined. 

Lg  arrival  time  (seconds 
into  day) . 

251-265 

F 

Variable- frequency 

detection  ratios. 

266-267 

A 

Date  on  which  data 

were  edited. 

268 

I 

Start  time  of  corresponding  seismogram  on 
a  subset  tape  (not  used  for  AEDS  data) . 

269 

F 

B  factor  for  P  wave  for  source-receiver 
n 

distance  (AEDS  data,  only). 

270 

F 

B  factor  for  P  wave 

distance  (AEDS  data 

for  source-receiver 

,  only)  . 

271 

F 

B  factor  for  Sn  wave  for  source-receiver 
distance  (AEDS  data,  only). 

272 

F 

B  factor  for  lg  wave  for  source-receiver 

distance  (AEDS  data 

,  only)  . 

275 

F 

B  factor  for  long-period  surface  wave  for 
source- receiver  distance  (AEDS  data,  only) 

274 

I 

Edit  start  time  index  into  the  available 
data  (AEDS  data,  only). 

275-276 

Available  for  future  use. 

277-556 

I 

Parameters  used  by 
(AEDS  data ,  only) . 

subroutine  MSDISC 

296-555 

F 

Sensor  East  Cartesian  coordinates  with 
resnect  to  the  reference  sensor  (km) . 

556-575 

F 

Sensor  North  Cartesian  coordinates  with 
respect  to  the  reference  sensor  (km) . 

*A  »  Alphanumeric,  I  =  Integer,  F  =  Floating  Point 
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TABLE  C-3 

RAW  SIGNAL  MEASUREMENTS 


Real  *4  Word 

Description 

Long-Period 

1 

18-22  sec  Vertical  Log  A/T  * 

2 

50  sec  Vertical  Log  A  ** 

3 

33.3  sec  Vertical  Log  A 

4 

25  sec  Vertical  Log  A 

5 

20  sec  Vertical  Log  A 

6 

17  sec  Vertical  Log  A 

7 

14  sec  Vertical  Log  A 

8 

12  sec  Vertical  Log  A 

9 

25  sec  Transverse  Log  A 

Short-Period 

10 

P-wave  log  A/T  (A<20°) 

11 

S-wave  log  A/T  (A<20°) 

12 

Lg-wave  log  A/T  (A<20°) 

13 

P-wave  log  A/T  (A>20°) 

14 

0.316  Hz  Vertical  Log  A 

15 

0.501  Hz  Vertical  Log  A 

16 

0.794  Hz  Vertical  Log  A 

17 

1.259  Hz  Vertical  Log  A 

18 

1.995  Hz  Vertical  Log  A 

19 

3.162  Hz  Vertical  Log  A 

20 

5.012  Hz  Vertical  Log  A 

21 

7.943  Hz  Vertical  Log  A 

22 

Maximum  mean  frequency 

23 

Mean  phase  standard  deviation 

24 

Broadband  complexity 

25 

Minimum  narrowband  complexity 

*  Log  A/T  =  logarithm  (base  10)  amplitude/period  +  B-factor 


**  Log  A  =  logarithm  (base  10)  amplitude  +  B-factor 
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